--- bin/configure.old Sat Jul 5 12:09:53 2008 +++ bin/configure Sat Jul 5 12:10:20 2008 @@ -118,7 +118,17 @@ }; eval { + if ($^O ne 'VMS') { $WebServer_gid = join(',', map { lc(getgrgid( $_ )) } split( ' ', $( )); + } else { + # getgid not working in perl 5.8.6 on VMS + # And we want it in text if possible, so can not use the builtin + # getuid() and split it appart. + my $uic = qx(write sys\$output f\$getjpi\(\"\",\"uic"\)); + $uic =~ /\[(.+),/; + my $gid = $1; + $WebServer_gid = lc($gid); + } }; if( $@ ) { # Try to use Cygwin's 'id' command - may be on the path, since Cygwin @@ -126,7 +136,17 @@ # up. # Run command without stderr output, to avoid CGI giving error. # Get names of primary and other groups. + if ($^O ne 'VMS') { $WebServer_gid = lc(qx(sh -c '( id -un ; id -gn) 2>/dev/null' 2>nul )); + } else { + # getgid not working in perl 5.8.6 on VMS + # And we want it in text if possible, so can not use the builtin + # getuid() and split it appart. + my $uic = qx(write sys\$output f\$getjpi\(\"\",\"uic"\)); + $uic =~ /\[(.+),/; + my $gid = $1; + $WebServer_gid = lc($gid); + } } my $localLibFailure; @@ -197,14 +217,21 @@ # Set the working dir to the bin dir no warnings; -$FindBin::Bin =~ /^(.*)$/; +my $twiki_bin; +if ($^O ne 'VMS') { + $twiki_bin = $FindBin::Bin; +} else { + # Findbin::Bin is not working on Perl 5.8.6 from HP on VMS. + my ($vol,$dir,$file) = File::Spec->splitpath($0); + $twiki_bin = File::Spec->catpath($vol, $dir, ''); +} +$twiki_bin =~ /^(.*)$/; use warnings; chdir($1); -my @root = File::Spec->splitdir($1); -pop(@root); -my @script = File::Spec->splitdir($0); +my ($root_vol, $root_dirs) = File::Spec->splitpath($1); +my @script = File::Spec->splitpath($0); my $scriptName = pop(@script); -$scriptName =~ s/.*[\/\\]//; # Fix for Item3511, on Win XP +$scriptName =~ s/.*[\/\\]// unless $^O eq 'VMS'; # Fix for Item3511, on Win XP # Try to load the LocalLib.cfg optional overload @@ -219,7 +246,12 @@ # Stick the root/lib on the path; there's a high probability we'll be # able to find the bits of TWiki::Configure that way. We will report # the setlib error later. - unshift(@INC, File::Spec->catfile(@root, 'lib')); + + my @dirs = File::Spec->splitdir($root_dirs); + pop @dirs; + my $new_dirs = File::Spec->catdir(@dirs, 'lib'); + my $new_inc = File::Spec->catpath($root_vol, $new_dirs, ''); + unshift(@INC, $new_inc); } # Load all the bits of the configure module that we explicitly use @@ -284,8 +316,9 @@ $file =~ s(::)(/)g; foreach my $dir ( @INC ) { - if ( -e "$dir/$file" ) { - return "$dir/$file"; + my $filespec = File::Spec->catfile($dir,$file); + if ( -e "$filespec" ) { + return "$filespec"; } } return undef; --- lib/twiki/configure/checkers/CGISetup.pm_old Thu Jul 3 21:16:05 2008 +++ lib/twiki/configure/checkers/CGISetup.pm Sat Jun 28 15:48:04 2008 @@ -253,9 +253,12 @@ # File DEPENDENCIES is in the lib dir (Item3478) my $from = TWiki::findFileOnPath('TWiki.spec'); - my @dir = File::Spec->splitdir( $from ); - pop(@dir); # Cutting off trailing TWiki.spec gives us lib dir - $from = File::Spec->catfile(@dir, 'DEPENDENCIES'); + + # Collect the volume and path information. + my ($vol, $dirs) = File::Spec->splitpath( $from ); + + # Change the filename. + $from = File::Spec->catpath($vol, $dirs, 'DEPENDENCIES'); my $d; open($d, '<'.$from) || return 'Failed to load DEPENDENCIES: '.$!; my @perlModules; --- lib/twiki/configure/checker.pm_old Thu Jul 3 22:15:16 2008 +++ lib/twiki/configure/checker.pm Sat Jun 28 17:06:26 2008 @@ -54,10 +54,20 @@ my $msg = ''; if( !$TWiki::cfg{$cfg} || $TWiki::cfg{$cfg} eq 'NOT SET') { require FindBin; - $FindBin::Bin =~ /^(.*)$/; - my @root = File::Spec->splitdir($1); + my $twiki_bin; + if ($^O ne 'VMS') { + $twiki_bin = $FindBin::Bin; + } else { + # Findbin::Bin is not working on Perl 5.8.6 from HP on VMS. + my ($vol,$dir,$file) = File::Spec->splitpath($0); + $twiki_bin = File::Spec->catpath($vol, $dir, ''); + } + $twiki_bin =~ /^(.*)$/; + my ($root_vol, $root_dirs) = File::Spec->splitpath($1); + my @root = File::Spec->splitdirs($root_dirs); pop(@root); - $TWiki::cfg{$cfg} = File::Spec->catfile(@root, $dir); + my $new_root_dirs = File::Spec->catdir(@root, $dir); + $TWiki::cfg{$cfg} = File::Spec->catpath($root_vol, $new_root_dirs, ''); $msg = $this->guessed(); } unless ($silent || -d $TWiki::cfg{$cfg}) { @@ -114,11 +124,9 @@ return checkTreePerms($name,'rw'); } # check the containing dir - my @path = File::Spec->splitdir($name); - pop(@path); - unless( -w File::Spec->catfile(@path, '')) { - return File::Spec->catfile(@path, '').' is not writable'; - } + my ($vol, $dirs) = File::Spec->splitpath($name); + my $test_name = File::Spec->catpath($vol, $dirs, ''); + return "$test_name is not writable" unless (-w $test_name); my $txt1 = "test 1 2 3"; open( FILE, ">$name" ) || return 'Could not create test file '. $name.':'.$!; --- lib/twiki/configure/uis/AUTH.pm_old Thu Jul 3 21:08:21 2008 +++ lib/twiki/configure/uis/AUTH.pm Sat Jun 28 20:54:16 2008 @@ -32,9 +32,9 @@ my ($this, $canChangePW, $actionMess) = @_; my $output = ''; - my @script = File::Spec->splitdir($ENV{SCRIPT_NAME}); + my @script = File::Spec->splitpath($ENV{SCRIPT_NAME}); my $scriptName = pop(@script); - $scriptName =~ s/.*[\/\\]//; # Fix for Item3511, on Win XP + $scriptName =~ s/.*[\/\\]// if $^O ne 'VMS'; # Fix for Item3511, on Win XP $output .= CGI::start_form({ action=>$scriptName, method=>'post' }); --- lib/twiki/configure/uis/EXTENSIONS.pm_old Thu Jul 3 21:03:38 2008 +++ lib/twiki/configure/uis/EXTENSIONS.pm Sat Jun 28 16:20:36 2008 @@ -96,9 +96,11 @@ foreach my $f (@tableHeads) { my $text; if ($f eq 'install') { - my @script = File::Spec->splitdir($ENV{SCRIPT_NAME}); + my @script = File::Spec->splitpath($ENV{SCRIPT_NAME}); my $scriptName = pop(@script); - $scriptName =~ s/.*[\/\\]//; # Fix for Item3511, on Win XP + + # Fix for Item3511, on Win XP + $scriptName =~ s/.*[\/\\]// unless $^0 eq 'VMS'; my $link = $scriptName. '?action=InstallExtension'. --- lib/twiki/configure/uis/FINDEXTENSIONS.pm_old Thu Jul 3 20:55:27 2008 +++ lib/twiki/configure/uis/FINDEXTENSIONS.pm Sat Jun 28 16:21:54 2008 @@ -40,9 +40,11 @@ if (!$bad) { # Can't use a submit here, because if we do, it is invoked when # the user presses Enter in a text field. - my @script = File::Spec->splitdir($ENV{SCRIPT_NAME} || 'THISSCRIPT'); + my @script = File::Spec->splitpath($ENV{SCRIPT_NAME} || 'THISSCRIPT'); my $scriptName = pop(@script); - $scriptName =~ s/.*[\/\\]//; # Fix for Item3511, on Win XP + + # Fix for Item3511, on Win XP + $scriptName =~ s/.*[\/\\]// unless $^O eq 'VMS'; $actor = CGI::a({ href => $scriptName.'?action=FindMoreExtensions', class=>'twikiSubmit', --- lib/twiki/configure/UI.pm_old Thu Jul 3 21:35:17 2008 +++ lib/twiki/configure/UI.pm Thu Jul 3 21:41:22 2008 @@ -39,10 +39,17 @@ my $this = bless( { item => $item }, $class); $this->{item} = $item; + if ($^O ne 'VMS') { $this->{bin} = $FindBin::Bin; - my @root = File::Spec->splitdir($this->{bin}); + } else { + # Findbin::Bin is not working on Perl 5.8.6 from HP on VMS. + my ($vol,$dir,$file) = File::Spec->splitpath($0); + $this->{bin} = File::Spec->catpath($vol, $dir, ''); + } + my ($root_vol, $root_dirs) = File::Spec->splitpath($this->{bin}); + my @root = File::Spec->splitdir($root_dirs); pop(@root); - $this->{root} = File::Spec->catfile(@root, ''); + $this->{root} = File::Spec->catpath($root_vol, @root, ''); return $this; } @@ -205,6 +212,14 @@ return 0; } + # The VMS/Perl crypt() function expects that the second parameter + # is a valid user and checks the password against the SYSUAF database + # So no point in saving or checking $TWiki::cfg{Password} + # Also can not be changed through TWiki. + if ($^O eq 'VMS') { + require Digest::MD5; + } + # If we get this far, a password has been given. Check it. if (!$TWiki::cfg{Password} && !$TWiki::query->param('confCfgP')) { # No password passed in, and TWiki::cfg doesn't contain a password @@ -216,11 +231,20 @@ } # If a password has been defined, check that it has been used - if ($TWiki::cfg{Password} && - crypt($pass, $TWiki::cfg{Password}) ne $TWiki::cfg{Password}) { + if ($TWiki::cfg{Password}) { + my $crypted; + if ($^O ne 'VMS') { + $crypted = crypt($pass, $TWiki::cfg{Password}); + } else { + my $login = $TWiki::cfg{AdminUserLogin}; + my $toEncode= "$login:$TWiki::cfg{AuthRealm}:$pass"; + my $crypted = Digest::MD5::md5_hex( $toEncode ); + } + if ($crypted ne $TWiki::cfg{Password}) { print CGI::div({class=>'error'}, "Password incorrect"); return 0; } + } # Password is correct, or no password defined # Change the password if so requested @@ -258,10 +282,18 @@ sub _encode { my $pass = shift; + if ($^O ne 'VMS') { my @saltchars = ( 'a'..'z', 'A'..'Z', '0'..'9', '.', '/' ); my $salt = $saltchars[int(rand($#saltchars+1))] . $saltchars[int(rand($#saltchars+1)) ]; return crypt($pass, $salt); + } else { + # VMS/Perl crypt only works for VMS usernames. + my $login = $TWiki::cfg{AdminUserLogin}; + my $toEncode= "$login:$TWiki::cfg{AuthRealm}:$pass"; + my $crypted = Digest::MD5::md5_hex( $toEncode ); + return $crypted; + } } 1; --- lib/twiki/users/baseusermapping.pm_old Thu Jul 3 15:51:57 2008 +++ lib/twiki/users/baseusermapping.pm Thu Jul 3 15:55:15 2008 @@ -447,6 +447,21 @@ $this->ASSERT_IS_USER_LOGIN_ID($login) if DEBUG; my $cUID = getCanonicalUserID( $this, $login ); return unless ($cUID); #user not found + + # crypt on VMS only works for VMS usernames for privileged users. + if (($^O eq 'VMS') && ($cUID eq $this->{mapping_id}.'333')) { + require Digest::MD5; + + my $hash = $this->{U2P}->{$cUID}; + + my $toEncode= "$login:$TWiki::cfg{AuthRealm}:$pass"; + my $crypted = Digest::MD5::md5_hex( $toEncode ); + + return 1 if ($crypted eq $hash); + + $this->{error} = 'Password validation failed.'; + return 0; + } my $hash = $this->{U2P}->{$cUID}; if ($hash && (crypt($pass, $hash) eq $hash)) {