--- loncom/lonnet/perl/lonnet.pm 2002/08/05 21:02:07 1.261 +++ loncom/lonnet/perl/lonnet.pm 2002/08/08 20:33:50 1.264 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.261 2002/08/05 21:02:07 albertel Exp $ +# $Id: lonnet.pm,v 1.264 2002/08/08 20:33:50 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -608,6 +608,18 @@ sub userenvironment { return %returnhash; } +# -------------------------------------------------------------------- New chat + +sub chatsend { + my ($newentry,$anon)=@_; + my $cnum=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $chome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'}; + &reply('chatsend:'.$cdom.':'.$cnum.':'. + &escape($ENV{'user.domain'}.':'.$ENV{'user.name'}.':'.$anon.':'. + &escape($newentry)),$chome); +} + # ----------------------------- Subscribe to a resource, return URL if possible sub subscribe { @@ -766,10 +778,15 @@ sub userfileupload { } # Notify homeserver to grep it # -# FIXME - this still needs to happen + if +(&reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome) eq 'ok') + { # # Return the URL to it - return '/uploaded/'.$path.$fname; + return '/uploaded/'.$path.$fname; + } else { + return '/adm/notfound.html'; + } } # ------------------------------------------------------------------------- Log @@ -1580,6 +1597,17 @@ sub allowed { return ''; } } + if ($ENV{'request.role'}=~ /li\.\//) { + # Library role, so allow browsing of resources in this domain. + return 'F'; + } + } + # Domain coordinator is trying to create a course + if (($priv eq 'ccc') && ($ENV{'request.role'} =~ /^dc\./)) { + # uri is the requested domain in this case. + # comparison to 'request.role.domain' shows if the user has selected + # a role of dc for the domain in question. + return 'F' if ($uri eq $ENV{'request.role.domain'}); } my $thisallowed=''; @@ -2167,13 +2195,10 @@ sub writecoursepref { # ---------------------------------------------------------- Make/modify course sub createcourse { - my ($udom,$description,$url)=@_; + my ($udom,$description,$url,$course_server)=@_; $url=&declutter($url); my $cid=''; - unless (&allowed('ccc',$ENV{'user.domain'})) { - return 'refused'; - } - unless ($udom eq $ENV{'user.domain'}) { + unless (&allowed('ccc',$udom)) { return 'refused'; } # ------------------------------------------------------------------- Create ID @@ -2189,9 +2214,14 @@ sub createcourse { return 'error: unable to generate unique course-ID'; } } +# ------------------------------------------------ Check supplied server name + $course_server = $ENV{'user.homeserver'} if (! defined($course_server)); + if (! exists($libserv{$course_server})) { + return 'error:bad server name '.$course_server; + } # ------------------------------------------------------------- Make the course my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::', - $ENV{'user.home'}); + $course_server); unless ($reply eq 'ok') { return 'error: '.$reply; } $uhome=&homeserver($uname,$udom,'true'); if (($uhome eq '') || ($uhome eq 'no_host')) {