--- loncom/lond 2004/03/23 11:50:12 1.178.2.13 +++ loncom/lond 2004/04/29 10:35:07 1.178.2.21 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.178.2.13 2004/03/23 11:50:12 foxr Exp $ +# $Id: lond,v 1.178.2.21 2004/04/29 10:35:07 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,7 +53,7 @@ my $DEBUG = 1; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.178.2.13 $'; #' stupid emacs +my $VERSION='$Revision: 1.178.2.21 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -796,7 +796,7 @@ sub ChangePasswordHandler { # First require that the user can be authenticated with their # old password: - my $validated = ValidUser($udom, $uname, $upass); + my $validated = ValidateUser($udom, $uname, $upass); if($validated) { my $realpasswd = GetAuthType($udom, $uname); # Defined since authd. @@ -890,6 +890,7 @@ sub AddUserHandler { for (my $i=3;$i<= ($#fpparts-1);$i++) { $fpnow.='/'.$fpparts[$i]; unless (-e $fpnow) { + &logthis("mkdir $fpnow"); unless (mkdir($fpnow,0777)) { $fperror="error: ".($!+0)." mkdir failed while attempting " ."makeuser"; @@ -989,7 +990,7 @@ sub IsHomeHandler { my ($udom,$uname)=split(/:/,$tail); chomp($uname); - my $passfile = PasswordPath($udom, $uname); + my $passfile = PasswordFilename($udom, $uname); if($passfile) { Reply( $client, "found\n", $userinput); } else { @@ -1027,7 +1028,9 @@ sub UpdateResourceHandler { my $userinput = "$cmd:$tail"; - my $fname=$tail; + my $fname=split(/:/,$tail); # This allows interactive testing + chomp($fname); # with telnet. + my $ownership=ishome($fname); if ($ownership eq 'not_owner') { if (-e $fname) { @@ -1137,10 +1140,7 @@ sub FetchUserFileHandler { } RegisterHandler("fetchuserfile", \&FetchUserFileHandler, 0, 1, 0); # -# Authenticate access to a user file. Question? The token for athentication -# is allowed to be sent as cleartext is this really what we want? This token -# represents the user's session id. Once it is forged does this allow too much -# access?? +# Authenticate access to a user file. # # Parameters: # $cmd - The command that got us here. @@ -1190,15 +1190,20 @@ sub UnsubscribeHandler { my $client = shift; my $userinput= "$cmd:$tail"; - my $fname = $tail; + my ($fname) = split(/:/,$tail); # This allows for interactive testing + # e.g. manual telnet and unsub:res: + # Otherwise the \r gets in the way. + chomp($fname); + Debug("Unsubscribing $fname"); if (-e $fname) { - Reply($client, &unsub($client,$fname,$clientip), $userinput); + Debug("Exists"); + Reply($client, &unsub($fname,$clientip), $userinput); } else { Failure($client, "not_found\n", $userinput); } return 1; } -RegisterHandler("unusb", \&UnsubscribeHandler, 0, 1, 0); +RegisterHandler("unsub", \&UnsubscribeHandler, 0, 1, 0); # Subscribe to a resource # @@ -1412,9 +1417,9 @@ sub RolesPutHandler { my $client = shift; my $userinput = "$cmd:$tail"; - my ($exedom,$exeuser,$udom,$uname,$what) =split(/:/,$tail); - &Debug("cmd = ".$cmd." exedom= ".$exedom."user = ".$exeuser." udom=".$udom. - "what = ".$what); + my ( $exedom, $exeuser, $udom, $uname, $what) = split(/:/,$tail); + + my $namespace='roles'; chomp($what); my $hashref = TieUserHash($udom, $uname, $namespace, @@ -1616,7 +1621,7 @@ sub GetProfileEntryEncrypted { return 1; } -RegisterHandler("eget", \&GetProfileEncrypted, 0, 1, 0); +RegisterHandler("eget", \&GetProfileEntryEncrypted, 0, 1, 0); # # Deletes a key in a user profile database. @@ -1847,7 +1852,8 @@ sub DumpWithRegexp { } RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0); -# Store an aitem in any database but the roles database. +# Store an aitem in any resource meta data(?) or database with +# versioning? # # Parameters: # $cmd - Request command keyword. @@ -2222,19 +2228,24 @@ sub DumpCourseIdHandler { } unless (defined($since)) { $since=0; } my $qresult=''; - + logthis(" Looking for $description since $since"); my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT()); if ($hashref) { while (my ($key,$value) = each(%$hashref)) { my ($descr,$lasttime)=split(/\:/,$value); + logthis("Got: key = $key descr = $descr time: $lasttime"); if ($lasttime<$since) { + logthis("Skipping .. too early"); next; } if ($description eq '.') { + logthis("Adding wildcard match"); $qresult.=$key.'='.$descr.'&'; } else { my $unescapeVal = &unescape($descr); + logthis("Matching with $unescapeVal"); if (eval('$unescapeVal=~/$description/i')) { + logthis("Adding on match"); $qresult.="$key=$descr&"; } } @@ -2492,10 +2503,15 @@ sub LsHandler { my $userinput = "$cmd:$ulsdir"; + chomp($ulsdir); + my $ulsout=''; my $ulsfn; + logthis("ls for '$ulsdir'"); if (-e $ulsdir) { + logthis("ls - directory exists"); if(-d $ulsdir) { + logthis("ls $ulsdir is a file"); if (opendir(LSDIR,$ulsdir)) { while ($ulsfn=readdir(LSDIR)) { my @ulsstats=stat($ulsdir.'/'.$ulsfn); @@ -2679,6 +2695,8 @@ sub ProcessRequest { # Split off the request keyword from the rest of the stuff. my ($command, $tail) = split(/:/, $userinput, 2); + chomp($command); + chomp($tail); Debug("Command received: $command, encoded = $wasenc"); @@ -2720,7 +2738,7 @@ sub ProcessRequest { $KeepGoing = &$Handler($command, $tail, $client); } else { Debug("Refusing to dispatch because ok is false"); - Failure($client, "refused", $userinput); + Failure($client, "refused\n", $userinput); } @@ -3807,9 +3825,13 @@ sub propath { sub ishome { my $author=shift; + Debug("ishome: $author"); $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; + Debug(" after big regsub: $author"); my ($udom,$uname)=split(/\//,$author); + Debug(" domain: $udom user: $uname"); my $proname=propath($udom,$uname); + Debug(" path = $proname"); if (-e $proname) { return 'owner'; } else { @@ -4035,7 +4057,7 @@ sub ManagePermissions { my $authtype= shift; # See if the request is of the form /$domain/_au - &logthis("ruequest is $request"); + &logthis("request is $request"); if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput... my $execdir = $perlvar{'lonDaemons'}; my $userhome= "/home/$user" ; @@ -4185,7 +4207,7 @@ sub ValidateUser { $validated = (crypt($password, $contentpwd) eq $contentpwd); } elsif ($howpwd eq "unix") { # User is a normal unix user. - $contentpwd = (getpwname($user))[1]; + $contentpwd = (getpwnam($user))[1]; if($contentpwd) { if($contentpwd eq 'x') { # Shadow password file... my $pwauth_path = "/usr/local/sbin/pwauth"; @@ -4275,15 +4297,25 @@ sub addline { my $expr='^'.$hostid.':'.$ip.':'; $expr =~ s/\./\\\./g; my $sh; + Debug("Looking for $expr"); if ($sh=IO::File->new("$fname.subscription")) { while (my $subline=<$sh>) { - if ($subline !~ /$expr/) {$contents.= $subline;} else {$found=1;} + Debug("addline: line: $subline"); + if ($subline !~ /$expr/) { + $contents.= $subline; + } else { + Debug("Found $subline"); + $found=1; + } } $sh->close(); } $sh=IO::File->new(">$fname.subscription"); if ($contents) { print $sh $contents; } - if ($newline) { print $sh $newline; } + if ($newline) { + Debug("Appending $newline"); + print $sh $newline; + } $sh->close(); return $found; } @@ -4356,17 +4388,36 @@ sub chatadd { sub unsub { my ($fname,$clientip)=@_; my $result; + my $unsubs = 0; # Number of successful unsubscribes: + + + # An old way subscriptions were handled was to have a + # subscription marker file: + + Debug("Attempting unlink of $fname.$clientname"); if (unlink("$fname.$clientname")) { - $result="ok\n"; - } else { - $result="not_subscribed\n"; - } + $unsubs++; # Successful unsub via marker file. + } + + # The more modern way to do it is to have a subscription list + # file: + if (-e "$fname.subscription") { my $found=&addline($fname,$clientname,$clientip,''); - if ($found) { $result="ok\n"; } + if ($found) { + $unsubs++; + } + } + + # If either or both of these mechanisms succeeded in unsubscribing a + # resource we can return ok: + + if($unsubs) { + $result = "ok\n"; } else { - if ($result != "ok\n") { $result="not_subscribed\n"; } + $result = "not_subscribed\n"; } + return $result; } @@ -4418,12 +4469,15 @@ sub thisversion { sub subscribe { my ($userinput,$clientip)=@_; + chomp($userinput); my $result; my ($cmd,$fname)=split(/:/,$userinput); my $ownership=&ishome($fname); + Debug("subscribe: Owner = $ownership file: '$fname'"); if ($ownership eq 'owner') { # explitly asking for the current version? unless (-e $fname) { + Debug("subscribe - does not exist"); my $currentversion=¤tversion($fname); if (&thisversion($fname)==$currentversion) { if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) { @@ -4439,6 +4493,7 @@ sub subscribe { } } if (-e $fname) { + Debug("subscribe - exists"); if (-d $fname) { $result="directory\n"; } else { @@ -4487,23 +4542,35 @@ sub make_passwd_file { print $pf "localauth:$npass\n"; } } elsif ($umode eq 'unix') { - { - my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; - { - &Debug("Executing external: ".$execpath); - &Debug("user = ".$uname.", Password =". $npass); - my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log"); - print $se "$uname\n"; - print $se "$npass\n"; - print $se "$npass\n"; - } - my $useraddok = $?; - if($useraddok > 0) { - &logthis("Failed lcuseradd: ".&lcuseraddstrerror($useraddok)); - } - my $pf = IO::File->new(">$passfilename"); - print $pf "unix:\n"; + # + # Don't allow the creation of privileged accounts!!! that would + # be real bad!!! + # + my $uid = getpwnam($uname); + if((defined $uid) && ($uid == 0)) { + &logthis(">>>Attempted add of privileged account blocked<<<"); + return "no_priv_account_error\n"; + } + + # + my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; + + &Debug("Executing external: ".$execpath); + &Debug("user = ".$uname.", Password =". $npass); + my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log"); + print $se "$uname\n"; + print $se "$npass\n"; + print $se "$npass\n"; + + my $useraddok = $?; + if($useraddok > 0) { + my $lcstring = lcuseraddstrerror($useraddok); + &logthis("Failed lcuseradd: $lcstring"); + return "error: lcuseradd failed: $lcstring\n"; } + my $pf = IO::File->new(">$passfilename"); + print $pf "unix:\n"; + } elsif ($umode eq 'none') { { my $pf = IO::File->new(">$passfilename"); @@ -4517,8 +4584,10 @@ sub make_passwd_file { sub sethost { my ($remotereq) = @_; + Debug("sethost got $remotereq"); my (undef,$hostid)=split(/:/,$remotereq); if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; } + Debug("sethost attempting to set host $hostid"); if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) { $currenthostid=$hostid; $currentdomainid=$hostdom{$hostid};