diff --git a/.github/workflows/code-review.yml b/.github/workflows/code-review.yml new file mode 100644 index 000000000..ec9d282e1 --- /dev/null +++ b/.github/workflows/code-review.yml @@ -0,0 +1,12 @@ +name: Code Review + +on: + pull_request: + branches: + - master + +jobs: + code-review: + uses: webmin/webmin-ci-cd/.github/workflows/code-review.yml@main + secrets: + CODE_REVIEW_API_KEY: ${{ secrets.CODE_REVIEW_API_KEY }} diff --git a/.github/workflows/tests.yml b/.github/workflows/tests.yml new file mode 100644 index 000000000..a07d9ff89 --- /dev/null +++ b/.github/workflows/tests.yml @@ -0,0 +1,19 @@ +name: Tests + +on: + pull_request: + branches: + - master + push: + branches: + - master + +jobs: + prove: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - name: Install Perl::Critic + run: sudo apt-get update && sudo apt-get install -y libperl-critic-perl + - name: prove -lr + run: prove -lr diff --git a/.github/workflows/webmin.dev+webmin.yml b/.github/workflows/webmin.dev+webmin.yml index 1ec6e6523..8ee6d540e 100644 --- a/.github/workflows/webmin.dev+webmin.yml +++ b/.github/workflows/webmin.dev+webmin.yml @@ -26,3 +26,4 @@ jobs: DEV_SSH_PRV_KEY: ${{ secrets.DEV_SSH_PRV_KEY }} ALL_GPG_PH2: ${{ secrets.ALL_GPG_PH2 }} CODE_REVIEW_API_KEY: ${{ secrets.CODE_REVIEW_API_KEY }} + CODE_REVIEW_SMTP_PASSWORD: ${{ secrets.CODE_REVIEW_SMTP_PASSWORD }} diff --git a/acl/acl-lib.pl b/acl/acl-lib.pl index 765286004..809f0ee44 100755 --- a/acl/acl-lib.pl +++ b/acl/acl-lib.pl @@ -1809,6 +1809,7 @@ foreach my $g (&list_groups()) { return $g; } } +return; } =head2 check_password_restrictions(username, password) diff --git a/acl/log_parser.pl b/acl/log_parser.pl index e164d976e..d61cf8d9c 100755 --- a/acl/log_parser.pl +++ b/acl/log_parser.pl @@ -16,8 +16,9 @@ my ($user, $script, $action, $type, $object, $p) = @_; my $g = $type eq 'group' ? "_g" : ""; if ($action eq 'modify') { if ($p->{'old'} ne $p->{'name'}) { - return &text('log_rename'.$g, "$p->{'old'}", - "$p->{'name'}"); + return &text('log_rename'.$g, + "".&html_escape($p->{'old'})."", + "".&html_escape($p->{'name'}).""); } else { return &text('log_modify'.$g, @@ -26,7 +27,8 @@ if ($action eq 'modify') { } elsif ($action eq 'create') { if ($p->{'clone'}) { - return &text('log_clone'.$g, "$p->{'clone'}", + return &text('log_clone'.$g, + "".&html_escape($p->{'clone'})."", "".&html_escape($object).""); } else { @@ -36,21 +38,23 @@ elsif ($action eq 'create') { } elsif ($action eq 'delete') { if ($type eq "users" || $type eq "groups") { - return &text('log_delete_'.$type, $object); + return &text('log_delete_'.$type, &html_escape($object)); } else { - return &text('log_delete'.$g, "$object"); + return &text('log_delete'.$g, + "".&html_escape($object).""); } } elsif ($action eq 'joingroup') { - return &text('log_joingroup', $object, $p->{'group'}); + return &text('log_joingroup', &html_escape($object), + &html_escape($p->{'group'})); } elsif ($action eq 'acl') { - return &text('log_acl', "$object", + return &text('log_acl', "".&html_escape($object)."", "".&html_escape($p->{'moddesc'}).""); } elsif ($action eq 'reset') { - return &text('log_reset', "$object", + return &text('log_reset', "".&html_escape($object)."", "".&html_escape($p->{'moddesc'}).""); } elsif ($action eq 'cert') { @@ -60,7 +64,9 @@ elsif ($action eq 'switch') { return &text('log_switch', "".&html_escape($object).""); } elsif ($action eq 'twofactor') { - return &text('log_twofactor', $object, $p->{'provider'}, $p->{'id'}); + return &text('log_twofactor', &html_escape($object), + &html_escape($p->{'provider'}), + &html_escape($p->{'id'})); } elsif ($action eq 'forgot') { return &text('log_forgot_'.$type, &html_escape($p->{'user'}), diff --git a/acl/t/run-tests.t b/acl/t/run-tests.t new file mode 100644 index 000000000..5f81caae0 --- /dev/null +++ b/acl/t/run-tests.t @@ -0,0 +1,1381 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Test::More; +use Cwd qw(abs_path); +use File::Temp qw(tempdir); + +sub script_dir +{ + my $path = $0; + if ($path =~ m{^/}) { + $path =~ s{/[^/]+$}{}; + return $path; + } + my $cwd = `pwd`; + chomp($cwd); + if ($path =~ m{/}) { + $path =~ s{/[^/]+$}{}; + return $cwd.'/'.$path; + } + return $cwd; +} + +my $bindir = script_dir(); +my $rootdir = abs_path("$bindir/../..") or die "rootdir: $!"; + +my $confdir = tempdir(CLEANUP => 1); +my $vardir = tempdir(CLEANUP => 1); +open(my $cfh, ">", "$confdir/config") or die "config: $!"; +# generic-linux (not just "linux") is what real modules list in their +# module.info os_support, so check_os_support() actually finds them. +print $cfh "os_type=generic-linux\nos_version=0\n"; +close($cfh); +open(my $vfh, ">", "$confdir/var-path") or die "var-path: $!"; +print $vfh "$vardir\n"; +close($vfh); +$ENV{'WEBMIN_CONFIG'} = $confdir; +$ENV{'WEBMIN_VAR'} = $vardir; +$ENV{'FOREIGN_MODULE_NAME'} = 'acl'; +$ENV{'FOREIGN_ROOT_DIRECTORY'} = $rootdir; + +chdir("$bindir/..") or die "chdir: $!"; + +require "$bindir/../acl-lib.pl"; +{ + my $r = do "$bindir/../acl_security.pl"; + if ($@) { die "compile acl_security.pl: $@" } + if (!defined($r) && $!) { die "open acl_security.pl: $!" } +} +{ + my $r = do "$bindir/../log_parser.pl"; + if ($@) { die "compile log_parser.pl: $@" } + if (!defined($r) && $!) { die "open log_parser.pl: $!" } +} +our (%text, %in, %gconfig); + +# Stage 2 fixture: a fully self-contained miniserv.conf + empty user/group/acl +# files under $confdir, plus stubs for side-effecting subs so tests don't try +# to signal a real miniserv or scan the whole module tree. +my $userfile = "$confdir/miniserv.users"; +my $groupfile = "$confdir/webmin.groups"; +my $aclfile = "$confdir/webmin.acl"; +my $miniservconf = "$confdir/miniserv.conf"; +sub _touch { open(my $f, ">", $_[0]) or die "$_[0]: $!"; close($f); } +_touch($userfile); +_touch($groupfile); +_touch($aclfile); +open(my $mfh, ">", $miniservconf) or die "$miniservconf: $!"; +print $mfh "userfile=$userfile\n"; +print $mfh "keyfile=$confdir/miniserv.pem\n"; +print $mfh "pidfile=$vardir/miniserv.pid\n"; +# Needed so @root_directories has a real value; without this, +# get_all_module_infos can't enumerate any modules. +print $mfh "root=$rootdir\n"; +close($mfh); +$ENV{'MINISERV_CONFIG'} = $miniservconf; + +{ + no warnings 'redefine', 'once'; + *reload_miniserv = sub { }; + *restart_miniserv = sub { }; + # list_modules() scans the whole module tree; for write-path tests we + # only need a small deterministic list. + *list_modules = sub { return qw(useradmin apache); }; +} + +sub _clear_caches +{ + no warnings 'once'; + # read_file_cached() cache + undef(%main::read_file_cache); + undef(%main::read_file_missing); + undef(%main::read_file_cache_time); + # read_file_lines() cache (used by list_groups, modify_group, delete_group) + undef(%main::file_cache); + undef(%main::file_cache_eol); + undef(%main::file_cache_noflush); + # read_acl() caches + undef(%main::acl_hash_cache); + undef(%main::acl_array_cache); +} + +sub _reset_fixture +{ + _touch($userfile); + _touch($groupfile); + _touch($aclfile); + _clear_caches(); + # Drop per-user gconfig keys so previous tests don't leak. + foreach my $k (keys %gconfig) { + delete($gconfig{$k}) if $k =~ /_(alice|bob|carol|anonymous|testu1)\b/; + } +} + +# --------------------------------------------------------------------------- +# CGI subprocess harness (Stage 3) +# +# The acl/*.cgi scripts are imperative top-to-bottom: no caller-guard, no +# sub definitions, no entry point we can require-and-call. To test them at +# the contract level we spawn each as a real subprocess with a constructed +# CGI environment, feed it a POST body, and assert on what an attacker +# would actually see: the redirect target on success, or the error page on +# failure. +# +# Lever for %access: acl-lib.pl line 24 does `our %access = &get_module_acl();` +# which reads /acl/.acl. _seed_user_acl writes that +# file, so each test controls the caller's privileges directly. +use IPC::Open3 (); +use Symbol qw(gensym); + +my $cgidir = "$confdir/acl"; +mkdir($cgidir) or die "$cgidir: $!" unless -d $cgidir; + +sub _urlenc { + my $s = shift; + $s = '' if !defined $s; + $s =~ s/([^A-Za-z0-9._~-])/sprintf('%%%02X', ord($1))/ge; + return $s; +} + +# Write /acl/.acl. Pass a hashref of ACL keys (create, edit, +# delete, switch, mode, mods, gassign, users, groups, perms, etc.). +sub _seed_user_acl { + my ($user, $acl) = @_; + open(my $fh, ">", "$cgidir/$user.acl") or die "$cgidir/$user.acl: $!"; + for my $k (sort keys %$acl) { + print $fh "$k=$acl->{$k}\n"; + } + close($fh); + _clear_caches(); +} + +# Build a urlencoded POST body from a form hashref. Array values get repeated. +sub _form_body { + my ($form) = @_; + my $body = ''; + for my $k (sort keys %$form) { + my @vals = ref($form->{$k}) eq 'ARRAY' ? @{$form->{$k}} : ($form->{$k}); + for my $v (@vals) { + $body .= '&' if length $body; + $body .= _urlenc($k) . '=' . _urlenc($v); + } + } + return $body; +} + +# Spawn an acl/ CGI as a subprocess. +# Returns a hashref: { out => stdout, err => stderr, status => exit code, +# location => Location: target if any, +# body => response body after blank line }. +sub run_cgi { + my ($cgi, $form, %opts) = @_; + my $body = _form_body($form || {}); + my $user = exists $opts{user} ? $opts{user} : 'admin'; + + my %env = ( + PATH => $ENV{PATH}, + WEBMIN_CONFIG => $confdir, + WEBMIN_VAR => $vardir, + FOREIGN_MODULE_NAME => 'acl', + FOREIGN_ROOT_DIRECTORY => $rootdir, + MINISERV_CONFIG => $miniservconf, + REQUEST_METHOD => 'POST', + SCRIPT_NAME => "/acl/$cgi", + CONTENT_TYPE => 'application/x-www-form-urlencoded', + CONTENT_LENGTH => length($body), + SERVER_NAME => 'localhost', + SERVER_PORT => '10000', + HTTP_HOST => 'localhost:10000', + ); + if (defined $user) { + $env{REMOTE_USER} = $user; + $env{BASE_REMOTE_USER} = $user; + } + if ($opts{env}) { + $env{$_} = $opts{env}{$_} for keys %{$opts{env}}; + } + + my $errfh = gensym(); + my $pid; + { + local %ENV = %env; + # Run from inside the acl module dir so `require './acl-lib.pl'` + # works as it does under miniserv. + $pid = IPC::Open3::open3(my $in, my $out, $errfh, + $^X, "-I$rootdir", "$rootdir/acl/$cgi"); + print $in $body if length $body; + close($in); + + my ($stdout, $stderr) = ('', ''); + # Read both streams non-deterministically to avoid pipe deadlock on + # very chatty CGIs. The body sizes here are small so a draining + # order is fine. + local $/; + $stdout = <$out>; $stdout = '' if !defined $stdout; + $stderr = <$errfh>; $stderr = '' if !defined $stderr; + close($out); close($errfh); + waitpid($pid, 0); + my $status = $? >> 8; + + my ($location) = $stdout =~ /^Location:\s*(\S+)/m; + my ($hdr, $rbody) = split(/\r?\n\r?\n/, $stdout, 2); + $rbody = '' if !defined $rbody; + return { + out => $stdout, + err => $stderr, + status => $status, + location => $location, + body => $rbody, + }; + } +} + +# Sanity: libs loaded and key subs are visible. +ok(defined &encrypt_password, 'acl-lib loaded encrypt_password'); +ok(defined &validate_password, 'acl-lib loaded validate_password'); +ok(defined &acl_security_save, 'acl_security.pl loaded acl_security_save'); +ok(defined &list_acl_yesno_fields, 'acl_security.pl loaded list_acl_yesno_fields'); + +# to64: small deterministic vectors over the itoa64 alphabet +# "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" +is(to64(0, 1), '.', 'to64 first char'); +is(to64(1, 1), '/', 'to64 second char'); +is(to64(63, 1), 'z', 'to64 last char'); +is(to64(63, 2), 'z.', 'to64 two chars zero high'); +is(to64(65, 2), '//', 'to64 spans 6-bit boundary'); + +# obsfucate_email: deterministic mask +is(obsfucate_email('foo@bar.com'), 'f**@b**.c**', + 'obsfucate_email three-letter labels'); +is(obsfucate_email('a@b.c'), 'a@b.c', + 'obsfucate_email single-letter labels unchanged'); +is(obsfucate_email('alice@mail.example.co.uk'), + 'a****@m***.e******.c*.u*', + 'obsfucate_email multi-label domain'); + +# md5-lib: encrypt / validate round-trips per scheme. +# Each check_* returns a missing-module name or undef-when-supported, which +# we use as the skip gate so tests pass on a minimal box. + +SKIP: { + skip 'MD5 unsupported', 5 if check_md5(); + my $h = encrypt_md5('hunter2', 'abcdefgh'); + like($h, qr/^\$1\$abcdefgh\$/, 'encrypt_md5 emits $1$ magic'); + is(encrypt_md5('hunter2', 'abcdefgh'), $h, 'encrypt_md5 deterministic'); + isnt(encrypt_md5('hunter3', 'abcdefgh'), $h, 'encrypt_md5 sensitive to password'); + ok(validate_password('hunter2', $h), 'validate_password matches md5 hash'); + ok(!validate_password('wrong', $h), 'validate_password rejects wrong md5'); +} + +SKIP: { + skip 'SHA512 unsupported', 4 if check_sha512(); + my $h = encrypt_sha512('hunter2', '$6$saltsalt$'); + like($h, qr/^\$6\$saltsalt\$/, 'encrypt_sha512 emits $6$ magic with given salt'); + is(encrypt_sha512('hunter2', '$6$saltsalt$'), $h, + 'encrypt_sha512 deterministic'); + ok(validate_password('hunter2', $h), 'validate_password matches sha512'); + ok(!validate_password('wrong', $h), 'validate_password rejects wrong sha512'); +} + +SKIP: { + skip 'yescrypt unsupported', 3 if check_yescrypt(); + # yescrypt salts are complex; reuse one generated by encrypt_yescrypt. + my $h = encrypt_yescrypt('hunter2'); + like($h, qr/^\$y\$/, 'encrypt_yescrypt emits $y$ magic'); + ok(validate_password('hunter2', $h), 'validate_password matches yescrypt'); + ok(!validate_password('wrong', $h), 'validate_password rejects wrong yescrypt'); +} + +SKIP: { + skip 'Crypt::Eksblowfish::Bcrypt missing', 4 if check_blowfish(); + my $h = encrypt_blowfish('hunter2'); + like($h, qr/^\$2a\$/, 'encrypt_blowfish emits $2a$ magic'); + is(encrypt_blowfish('hunter2', $h), $h, 'encrypt_blowfish reuses embedded salt'); + ok(validate_password('hunter2', $h), 'validate_password matches blowfish'); + ok(!validate_password('wrong', $h), 'validate_password rejects wrong blowfish'); +} + +# acl_security_save: contract test of the ACL parser that decides which other +# users a Webmin admin can manage. Drives the sub through every users_def +# branch, mode==2 branch, and all yes/no fields. +{ + no warnings 'once'; + local %in = ( + users_def => 1, + mode => 0, + groups => 1, + gassign_def => 1, + ); + my %o; + acl_security_save(\%o); + is($o{'users'}, '*', 'users_def=1 -> users="*"'); + is($o{'gassign'}, '*', 'gassign_def=1 -> gassign="*"'); +} + +{ + no warnings 'once'; + local %in = ( + users_def => 2, + mode => 0, + groups => 1, + gassign_def => 1, + ); + my %o; + acl_security_save(\%o); + is($o{'users'}, '~', 'users_def=2 -> users="~"'); +} + +{ + no warnings 'once'; + # users_def=0 with null-separated list (the wire format from