--- loncom/lond 2002/09/16 13:26:21 1.97 +++ loncom/lond 2002/10/07 13:50:36 1.102 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.97 2002/09/16 13:26:21 foxr Exp $ +# $Id: lond,v 1.102 2002/10/07 13:50:36 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -129,7 +129,7 @@ sub lcpasswdstrerror { if(($ErrorCode < 0) || ($ErrorCode > $lastpwderror)) { return "lcpasswd Unrecognized error return value ".$ErrorCode; } else { - return $passwderrors($ErrorCode); + return $passwderrors[$ErrorCode]; } } @@ -141,7 +141,7 @@ sub lcuseraddstrerror { if(($ErrorCode < 0) || ($ErrorCode > $lastadderror)) { return "lcuseradd - Unrecognized error code: ".$ErrorCode; } else { - return $adderrors($ErrorCode); + return $adderrors[$ErrorCode]; } } @@ -695,15 +695,22 @@ sub make_new_child { my ($howpwd,$contentpwd)=split(/:/,$realpasswd); my $pwdcorrect=0; if ($howpwd eq 'internal') { + &Debug("Internal auth"); $pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd); } elsif ($howpwd eq 'unix') { - $contentpwd=(getpwnam($uname))[1]; - my $pwauth_path="/usr/local/sbin/pwauth"; - unless ($contentpwd eq 'x') { - $pwdcorrect= - (crypt($upass,$contentpwd) eq $contentpwd); - } + &Debug("Unix auth"); + if((getpwnam($uname))[1] eq "") { #no such user! + $pwdcorrect = 0; + } else { + $contentpwd=(getpwnam($uname))[1]; + my $pwauth_path="/usr/local/sbin/pwauth"; + unless ($contentpwd eq 'x') { + $pwdcorrect= + (crypt($upass,$contentpwd) eq + $contentpwd); + } + elsif (-e $pwauth_path) { open PWAUTH, "|$pwauth_path" or die "Cannot invoke authentication"; @@ -711,6 +718,7 @@ sub make_new_child { close PWAUTH; $pwdcorrect=!$?; } + } } elsif ($howpwd eq 'krb4') { $null=pack("C",0); unless ($upass=~/$null/) { @@ -759,7 +767,7 @@ sub make_new_child { chomp($npass); $upass=&unescape($upass); $npass=&unescape($npass); - &logthis("Trying to change password for $uname"); + &Debug("Trying to change password for $uname"); my $proname=propath($udom,$uname); my $passfilename="$proname/passwd"; if (-e $passfilename) { @@ -769,6 +777,7 @@ sub make_new_child { chomp($realpasswd); my ($howpwd,$contentpwd)=split(/:/,$realpasswd); if ($howpwd eq 'internal') { + &Debug("internal auth"); if (crypt($upass,$contentpwd) eq $contentpwd) { my $salt=time; $salt=substr($salt,6,2); @@ -785,6 +794,7 @@ sub make_new_child { # one way or another. # First: Make sure the current password is # correct + &Debug("auth is unix"); $contentpwd=(getpwnam($uname))[1]; my $pwdcorrect = "0"; my $pwauth_path="/usr/local/sbin/pwauth"; @@ -796,11 +806,13 @@ sub make_new_child { die "Cannot invoke authentication"; print PWAUTH "$uname\n$upass\n"; close PWAUTH; - my $pwdcorrect=!$?; + &Debug("exited pwauth with $? ($uname,$upass) "); + $pwdcorrect=($? == 0); } if ($pwdcorrect) { my $execdir=$perlvar{'lonDaemons'}; - my $pf = IO::File->new("|$execdir/lcpasswd"); + &Debug("Opening lcpasswd pipeline"); + my $pf = IO::File->new("|$execdir/lcpasswd > /home/www/lcpasswd.log"); print $pf "$uname\n$npass\n$npass\n"; close $pf; my $err = $?; @@ -853,7 +865,7 @@ sub make_new_child { } } unless ($fperror) { - my $result=&make_passwd_file($umode,$npass, + my $result=&make_passwd_file($uname, $umode,$npass, $passfilename); print $client $result; } else { @@ -879,7 +891,7 @@ sub make_new_child { if ($udom ne $perlvar{'lonDefDomain'}) { print $client "not_right_domain\n"; } else { - my $result=&make_passwd_file($umode,$npass, + my $result=&make_passwd_file($uname, $umode,$npass, $passfilename); print $client $result; } @@ -1003,6 +1015,10 @@ sub make_new_child { # ------------------------------------------------------------------- subscribe } elsif ($userinput =~ /^sub/) { print $client &subscribe($userinput,$clientip); +# ------------------------------------------------------------- current version + } elsif ($userinput =~ /^currentversion/) { + my ($cmd,$fname)=split(/:/,$userinput); + print $client ¤tversion($fname)."\n"; # ------------------------------------------------------------------------- log } elsif ($userinput =~ /^log/) { my ($cmd,$udom,$uname,$what)=split(/:/,$userinput); @@ -1212,21 +1228,25 @@ sub make_new_child { } else { $regexp='.'; } - my $proname=propath($udom,$uname); my $qresult=''; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { + my $proname=propath($udom,$uname); + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) { study($regexp); - foreach $key (keys %hash) { - my $unescapeKey = &unescape($key); - if (eval('$unescapeKey=~/$regexp/')) { - $qresult.="$key=$hash{$key}&"; - } + while (($key,$value) = each(%hash)) { + if ($regexp eq '.') { + $qresult.=$key.'='.$value.'&'; + } else { + my $unescapeKey = &unescape($key); + if (eval('$unescapeKey=~/$regexp/')) { + $qresult.="$key=$value&"; + } + } } - if (untie(%hash)) { - $qresult=~s/\&$//; - print $client "$qresult\n"; + if (untie(%hash)) { + chop($qresult); + print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error:$!\n"; } } else { print $client "error:$!\n"; @@ -1631,12 +1651,68 @@ sub unsub { return $result; } +sub currentversion { + my $fname=shift; + my $version=-1; + my $ulsdir=''; + if ($fname=~/^(.+)\/[^\/]+$/) { + $ulsdir=$1; + } + $fname=~s/\.\d+\.(\w+(?:\.meta)*)$/\.$1/; + $fname=~s/\.(\w+(?:\.meta)*)$/\.\(\\d\+\)\.$1\$/; + + if (-e $fname) { $version=1; } + if (-e $ulsdir) { + if(-d $ulsdir) { + if (opendir(LSDIR,$ulsdir)) { + while ($ulsfn=readdir(LSDIR)) { +# see if this is a regular file (ignore links produced earlier) + my $thisfile=$ulsdir.'/'.$ulsfn; + unless (-l $thisfile) { + if ($thisfile=~/$fname/) { + if ($1>$version) { $version=$1; } + } + } + } + closedir(LSDIR); + $version++; + } + } + } + return $version; +} + +sub thisversion { + my $fname=shift; + my $version=-1; + if ($fname=~/\.(\d+)\.\w+(?:\.meta)*$/) { + $version=$1; + } + return $version; +} + sub subscribe { my ($userinput,$clientip)=@_; my $result; my ($cmd,$fname)=split(/:/,$userinput); my $ownership=&ishome($fname); if ($ownership eq 'owner') { +# explitly asking for the current version? + unless (-e $fname) { + my $currentversion=¤tversion($fname); + if (&thisversion($fname)==$currentversion) { + if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) { + my $root=$1; + my $extension=$2; + symlink($root.'.'.$extension, + $root.'.'.$currentversion.'.'.$extension); + unless ($extension=~/\.meta$/) { + symlink($root.'.'.$extension.'.meta', + $root.'.'.$currentversion.'.'.$extension.'.meta'); + } + } + } + } if (-e $fname) { if (-d $fname) { $result="directory\n"; @@ -1664,7 +1740,7 @@ sub subscribe { } sub make_passwd_file { - my ($umode,$npass,$passfilename)=@_; + my ($uname, $umode,$npass,$passfilename)=@_; my $result="ok\n"; if ($umode eq 'krb4' or $umode eq 'krb5') { { @@ -1690,7 +1766,8 @@ sub make_passwd_file { my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; { &Debug("Executing external: ".$execpath); - my $se = IO::File->new("|$execpath"); + &Debug("user = ".$uname.", Password =". $npass); + my $se = IO::File->new("|$execpath > /home/www/lcuseradd.log"); print $se "$uname\n"; print $se "$npass\n"; print $se "$npass\n";