--- loncom/lonnet/perl/lonnet.pm 2000/12/29 19:28:19 1.83 +++ loncom/lonnet/perl/lonnet.pm 2001/01/05 20:45:09 1.87 @@ -82,6 +82,8 @@ # 10/30,10/31, # 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27, # 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer +# 05/01/01 Guy Albertelli +# 05/01 Gerd Kortemeyer package Apache::lonnet; @@ -258,9 +260,11 @@ sub appenv { return 'error'; } my $newname; + flock($fh,'LOCK_EX'); foreach $newname (keys %newenv) { print $fh "$newname=$newenv{$newname}\n"; } + $fh->close(); } return 'ok'; } @@ -287,9 +291,11 @@ sub delenv { unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) { return 'error'; } + flock($fh,'LOCK_EX'); map { unless ($_=~/^$delthis/) { print $fh $_; } } @oldenv; + $fh->close(); } return 'ok'; } @@ -1300,6 +1306,64 @@ sub modifystudent { return &assignrole($udom,$uname,$uurl,'st',$end,$start); } +# ------------------------------------------------- Write to course preferences + +sub writecoursepref { + my ($courseid,%prefs)=@_; + $courseid=~s/^\///; + $courseid=~s/\_/\//g; + my ($cdomain,$cnum)=split(/\//,$courseid); + my $chome=homeserver($cnum,$cdomain); + if (($chome eq '') || ($chome eq 'no_host')) { + return 'error: no such course'; + } + my $cstring=''; + map { + $cstring.=escape($_).'='.escape($prefs{$_}).'&'; + } keys %prefs; + $cstring=~s/\&$//; + return reply('put:'.$cdomain.':'.$cnum.':environment:'.$cstring,$chome); +} + +# ---------------------------------------------------------- Make/modify course + +sub createcourse { + my ($udom,$description,$url)=@_; + $url=&declutter($url); + my $cid=''; + unless (&allowed('ccc',$ENV{'user.domain'})) { + return 'refused'; + } + unless ($udom eq $ENV{'user.domain'}) { + return 'refused'; + } +# ------------------------------------------------------------------- Create ID + my $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)). + unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'}; +# ----------------------------------------------- Make sure that does not exist + my $uhome=&homeserver($uname,$udom); + unless (($uhome eq '') || ($uhome eq 'no_host')) { + $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)). + unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'}; + $uhome=&homeserver($uname,$udom); + unless (($uhome eq '') || ($uhome eq 'no_host')) { + return 'error: unable to generate unique course-ID'; + } + } +# ------------------------------------------------------------- Make the course + my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::', + $ENV{'user.home'}); + unless ($reply eq 'ok') { return 'error: '.$reply; } + my $uhome=&homeserver($uname,$udom); + if (($uhome eq '') || ($uhome eq 'no_host')) { + return 'error: no such course'; + } + &writecoursepref($udom.'_'.$uname, + ('description' => $description, + 'url' => $url)); + return '/'.$udom.'/'.$uname; +} + # ---------------------------------------------------------- Assign Custom Role sub assigncustomrole {