--- loncom/lond 2011/08/05 04:35:45 1.480 +++ loncom/lond 2012/03/26 11:03:34 1.487 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.480 2011/08/05 04:35:45 raeburn Exp $ +# $Id: lond,v 1.487 2012/03/26 11:03:34 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -60,7 +60,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.480 $'; #' stupid emacs +my $VERSION='$Revision: 1.487 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -1709,7 +1709,7 @@ sub server_devalidatecache_handler { &Reply($client,\$result,$userinput); return 1; } -®ister_handler("devalidatecache", \&devalidatecache_handler, 0, 1, 0); +®ister_handler("devalidatecache", \&server_devalidatecache_handler, 0, 1, 0); sub server_timezone_handler { my ($cmd,$tail,$client) = @_; @@ -2073,7 +2073,7 @@ sub add_user_handler { ."makeuser"; } unless ($fperror) { - my $result=&make_passwd_file($uname, $umode,$npass, $passfilename); + my $result=&make_passwd_file($uname,$udom,$umode,$npass, $passfilename); &Reply($client,\$result, $userinput); #BUGBUG - could be fail } else { &Failure($client, \$fperror, $userinput); @@ -2148,7 +2148,7 @@ sub change_authentication_handler { &Failure($client, \$result); } } else { - my $result=&make_passwd_file($uname, $umode,$npass,$passfilename); + my $result=&make_passwd_file($uname,$udom,$umode,$npass,$passfilename); # # If the current auth mode is internal, and the old auth mode was # unix, or krb*, and the user is an author for this domain, @@ -2350,7 +2350,8 @@ sub fetch_user_file_handler { my $transname=$udir.'/'.$ufile.'.in.transit'; my $clientprotocol=$Apache::lonnet::protocol{$clientname}; $clientprotocol = 'http' if ($clientprotocol ne 'https'); - my $remoteurl=$clientprotocol.'://'.$clientip.'/userfiles/'.$fname; + my $clienthost = &Apache::lonnet::hostname($clientname); + my $remoteurl=$clientprotocol.'://'.$clienthost.'/userfiles/'.$fname; my $response; Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname"); alarm(120); @@ -3997,7 +3998,7 @@ sub dump_course_id_handler { $creationcontext = '.'; } my $unpack = 1; - if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && + if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' && $typefilter eq '.') { $unpack = 0; } @@ -6716,22 +6717,29 @@ sub is_author { # Author role should show up as a key /domain/_au - my $key = "/$domain/_au"; my $value; - if (defined($hashref)) { - $value = $hashref->{$key}; - } + if ($hashref) { - if(defined($value)) { - &Debug("$user @ $domain is an author"); + my $key = "/$domain/_au"; + if (defined($hashref)) { + $value = $hashref->{$key}; + if(!untie_user_hash($hashref)) { + return 'error: ' . ($!+0)." untie (GDBM) Failed"; + } + } + + if(defined($value)) { + &Debug("$user @ $domain is an author"); + } + } else { + return 'error: '.($!+0)." tie (GDBM) Failed"; } return defined($value); } # # Checks to see if the input roleput request was to set -# an author role. If so, invokes the lchtmldir script to set -# up a correct public_html +# an author role. If so, creates construction space # Parameters: # request - The request sent to the rolesput subchunk. # We're looking for /domain/_au @@ -6741,16 +6749,15 @@ sub is_author { # sub manage_permissions { my ($request, $domain, $user, $authtype) = @_; - - &Debug("manage_permissions: $request $domain $user $authtype"); - # See if the request is of the form /$domain/_au if($request =~ /^(\/\Q$domain\E\/_au)$/) { # It's an author rolesput... - my $execdir = $perlvar{'lonDaemons'}; - my $userhome= "/home/$user" ; - &logthis("system $execdir/lchtmldir $userhome $user $authtype"); - &Debug("Setting homedir permissions for $userhome"); - system("$execdir/lchtmldir $userhome $user $authtype"); + my $path=$perlvar{'lonDocRoot'}."/priv/$domain"; + unless (-e $path) { + mkdir($path); + } + unless (-e $path.'/'.$user) { + mkdir($path.'/'.$user); + } } } @@ -7283,7 +7290,7 @@ sub change_unix_password { sub make_passwd_file { - my ($uname, $umode,$npass,$passfilename)=@_; + my ($uname,$udom,$umode,$npass,$passfilename)=@_; my $result="ok"; if ($umode eq 'krb4' or $umode eq 'krb5') { { @@ -7324,7 +7331,7 @@ sub make_passwd_file { # my $uid = getpwnam($uname); if((defined $uid) && ($uid == 0)) { - &logthis(">>>Attempted to create privilged account blocked"); + &logthis(">>>Attempt to create privileged account blocked"); return "no_priv_account_error\n"; } @@ -7336,6 +7343,7 @@ sub make_passwd_file { &Debug("user = ".$uname.", Password =". $npass); my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log"); print $se "$uname\n"; + print $se "$udom\n"; print $se "$npass\n"; print $se "$npass\n"; print $se "$lc_error_file\n"; # Status -> unique file.