--- loncom/lonnet/perl/lonnet.pm 2000/11/28 02:48:25 1.73 +++ loncom/lonnet/perl/lonnet.pm 2000/12/13 22:45:22 1.80 @@ -45,7 +45,8 @@ # EXT(name) : value of a variable # symblist(map,hash) : Updates symbolic storage links # symbread([filename]) : returns the data handle (filename optional) -# rndseed() : returns a random seed +# rndseed() : returns a random seed +# receipt() : returns a receipt to be given out to users # getfile(filename) : returns the contents of filename, or a -1 if it can't # be found, replicates and subscribes to the file # filelocation(dir,file) : returns a farily clean absolute reference to file @@ -79,7 +80,8 @@ # 10/04 Guy Albertelli # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29, # 10/30,10/31, -# 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27 Gerd Kortemeyer +# 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27, +# 12/02,12/12,12/13 Gerd Kortemeyer package Apache::lonnet; @@ -382,7 +384,7 @@ sub idget { $idlist=~tr/A-Z/a-z/; my $reply=&reply("idget:$udom:".$idlist,$tryserver); my @answer=(); - if ($reply ne 'con_lost') { + if (($reply ne 'con_lost') && ($reply!~/^error\:/)) { @answer=split(/\&/,$reply); } ; my $i; @@ -631,9 +633,12 @@ sub restore { my ($name,$value)=split(/\=/,$_); $returnhash{&unescape($name)}=&unescape($value); } split(/\&/,$answer); - map { - $returnhash{$_}=$returnhash{$returnhash{'version'}.':'.$_}; - } split(/\:/,$returnhash{$returnhash{'version'}.':keys'}); + my $version; + for ($version=1;$version<=$returnhash{'version'};$version++) { + map { + $returnhash{$_}=$returnhash{$version.':'.$_}; + } split(/\:/,$returnhash{$version.':keys'}); + } return %returnhash; } @@ -1149,7 +1154,7 @@ sub fileembstyle { # ------------------------------------------------------------ Description Text -sub filedecription { +sub filedescription { my $ending=shift; return $fd{$ending}; } @@ -1182,6 +1187,102 @@ sub assignrole { return &reply($command,&homeserver($uname,$udom)); } +# ----------------------------------------------------------------- Make a user + + +sub makeuser { + my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene)=@_; + &logthis('Call to make user '.$udom.', '.$uname.', '.$uid.', '. + $umode.', '.$first.', '.$middle.', '. + $last.', '.$gene.' by '. + $ENV{'user.name'}.' at '.$ENV{'user.domain'}); + my $uhome=&homeserver($uname,$udom); +# ----------------------------------------------------------------- Create User + if ($uhome eq 'no_host') { + my $unhome=''; + if ($ENV{'course.'.$ENV{'request.course.id'}.'.domain'} eq $udom) { + $unhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'}; + } elsif ($ENV{'user.domain'} eq $udom) { + $unhome=$ENV{'user.home'}; + } else { + my $tryserver; + my $loadm=999999; + foreach $tryserver (keys %libserv) { + if ($hostdom{$tryserver} eq $udom) { + my $answer=reply('load',$tryserver); + if (($answer=~/\d+/) && ($answer<$loadm)) { + $loadm=$answer; + $unhome=$tryserver; + } + } + } + } + if (($unhome eq '') || ($unhome eq 'no_host')) { + return 'error: find home'; + } + my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':'.$umode.':'. + &escape($upass),$unhome); + unless ($reply eq 'ok') { + return 'error: '.$reply; + } + $uhome=&homeserver($uname,$udom); + if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) { + return 'error: verify home'; + } + } +# ---------------------------------------------------------------------- Add ID + if ($uid) { + $uid=~tr/A-Z/a-z/; + my %uidhash=&idrget($udom,$uname); + if (($uidhash{$uname}) && ($uidhash{$uname}!~/error\:/)) { + unless ($uid eq $uidhash{$uname}) { + return 'error: mismatch '.$uidhash{$uname}.' versus '.$uid; + } + } else { + &idput($udom,($uname => $uid)); + } + } +# -------------------------------------------------------------- Add names, etc + my $names=&reply('get:'.$udom.':'.$uname. + ':environment:firstname&middlename&lastname&generation', + $uhome); + my ($efirst,$emiddle,$elast,$egene)=split(/\&/,$names); + unless ($efirst) { $efirst = &escape($first); } + unless ($emiddle) { $emiddle = &escape($middle); } + unless ($elast) { $elast = &escape($last); } + unless ($egene) { $egene = &escape($gene); } + my $reply=&reply('put:'.$udom.':'.$uname. + ':environment:firstname='.$efirst. + '&middlename='.$emiddle. + '&lastname='.$elast. + '&generation='.$egene,$uhome); + if ($reply ne 'ok') { + return 'error: '.$reply; + } + &logthis('Success making user '.$udom.', '.$uname.', '.$uid.', '. + $umode.', '.$first.', '.$middle.', '. + $last.', '.$gene.' by '. + $ENV{'user.name'}.' at '.$ENV{'user.domain'}); + return 'ok'; +} + +# -------------------------------------------------------------- Make a student + +sub makestudent { + my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec)=@_; + unless ($ENV{'request.course.id'}) { + return 'not_in_class'; + } +# --------------------------------------------------------------- Make the user + my $reply=&makeuser + ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene); + unless ($reply eq 'ok') { return $reply; } +# -------------------------------------------------- Add student to course list + +# ---------------------------------------------------- Add student role to user + +} + # ---------------------------------------------------------- Assign Custom Role sub assigncustomrole { @@ -1421,26 +1522,14 @@ sub EXT { my $reply=&reply('get:'. $ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'. $ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}. - ':resourcedata:'. - escape($seclevelr).':'.escape($seclevelm).':'.escape($seclevel).':'. - escape($courselevelr).':'.escape($courselevelm).':'.escape($courselevel), + ':resourcedata:'. + &escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'. + &escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel), $ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'}); if ($reply!~/^error\:/) { - map { - my ($name,$value)=split(/\=/,$_); - $resourcedata{unescape($name)}=unescape($value); - } split(/\&/,$reply); - - if ($resourcedata{$seclevelr}) { return $resourcedata{$seclevelr}; } - if ($resourcedata{$seclevelm}) { return $resourcedata{$seclevelm}; } - if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; } - - if ($resourcedata{$courselevelr}) { - return $resourcedata{$courselevelr}; } - if ($resourcedata{$courselevelm}) { - return $resourcedata{$courselevelm}; } - if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; } - + map { + if ($_) { return &unescape($_); } + } split(/\&/,$reply); } # ------------------------------------------------------ third, check map parms @@ -1456,8 +1545,12 @@ sub EXT { # --------------------------------------------- last, look in resource metadata + $spacequalifierrest=~s/\./\_/; my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest); if ($metadata) { return $metadata; } + $metadata=&metadata($ENV{'request.filename'}, + 'parameter_'.$spacequalifierrest); + if ($metadata) { return $metadata; } # ---------------------------------------------------- Any other user namespace } elsif ($realm eq 'environment') { @@ -1476,6 +1569,7 @@ sub EXT { sub metadata { my ($uri,$what)=@_; + $uri=&declutter($uri); my $filename=$uri; $uri=~s/\.meta$//; @@ -1502,7 +1596,11 @@ sub metadata { map { $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_}; } @{$token->[3]}; - $metacache{$uri.':'.$unikey}=$parser->get_text('/'.$entry); + unless ( + $metacache{$uri.':'.$unikey}=$parser->get_text('/'.$entry) + ) { $metacache{$uri.':'.$unikey}= + $metacache{$uri.':'.$unikey.'.default'}; + } } } } @@ -1628,6 +1726,27 @@ sub rndseed { .$symbchck); } +sub ireceipt { + my ($funame,$fudom,$fucourseid,$fusymb)=@_; + my $cuname=unpack("%32C*",$funame); + my $cudom=unpack("%32C*",$fudom); + my $cucourseid=unpack("%32C*",$fucourseid); + my $cusymb=unpack("%32C*",$fusymb); + my $cunique=unpack("%32C*",$perlvar{'lonReceipt'}); + return unpack("%32C*",$perlvar{'lonHostID'}).'-'. + ($cunique%$cuname+ + $cunique%$cudom+ + $cusymb%$cuname+ + $cusymb%$cudom+ + $cucourseid%$cuname+ + $cucourseid%$cudom); +} + +sub receipt { + return &ireceipt($ENV{'user.name'},$ENV{'user.domain'}, + $ENV{'request.course.id'},&symbread()); +} + # ------------------------------------------------------------ Serves up a file # returns either the contents of the file or a -1 sub getfile {