--- loncom/lonnet/perl/lonnet.pm 2004/11/10 19:03:04 1.567 +++ loncom/lonnet/perl/lonnet.pm 2005/01/28 09:26:57 1.591 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.567 2004/11/10 19:03:04 raeburn Exp $ +# $Id: lonnet.pm,v 1.591 2005/01/28 09:26:57 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -38,7 +38,7 @@ use vars qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom %libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache %courselogs %accesshash %userrolehash $processmarker $dumpcount - %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseresdatacache + %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %courseresdatacache %userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit); @@ -157,22 +157,6 @@ sub reply { my ($cmd,$server)=@_; unless (defined($hostname{$server})) { return 'no_such_host'; } my $answer=subreply($cmd,$server); - if ($answer eq 'con_lost') { - #sleep 5; - #$answer=subreply($cmd,$server); - #if ($answer eq 'con_lost') { - # &logthis("Second attempt con_lost on $server"); - # my $peerfile="$perlvar{'lonSockDir'}/$server"; - # my $client=IO::Socket::UNIX->new(Peer =>"$peerfile", - # Type => SOCK_STREAM, - # Timeout => 10) - # or return "con_lost"; - # &logthis("Killing socket"); - # print $client "close_connection_exit\n"; - #sleep 5; - # $answer=subreply($cmd,$server); - #} - } if (($answer=~/^refused/) || ($answer=~/^rejected/)) { &logthis("WARNING:". " $cmd to $server returned $answer"); @@ -220,11 +204,8 @@ sub critical { } my $answer=reply($cmd,$server); if ($answer eq 'con_lost') { - my $pingreply=reply('ping',$server); &reconlonc("$perlvar{'lonSockDir'}/$server"); - my $pongreply=reply('pong',$server); - &logthis("Ping/Pong for $server: $pingreply/$pongreply"); - $answer=reply($cmd,$server); + my $answer=reply($cmd,$server); if ($answer eq 'con_lost') { my $now=time; my $middlename=$cmd; @@ -1406,13 +1387,13 @@ sub finishuserfileupload { } # Save the file { - #&Apache::lonnet::logthis("Saving to $filepath $file"); - open(my $fh,'>'.$filepath.'/'.$file); - print $fh $ENV{'form.'.$formname}; - close($fh); + open(FH,'>'.$filepath.'/'.$file); + print FH $ENV{'form.'.$formname}; + close(FH); } # Notify homeserver to grep it # + &Apache::lonnet::logthis("fetching ".$path.$file); my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome); if ($fetchresult eq 'ok') { # @@ -1490,12 +1471,12 @@ sub flushcourselogs { if ($courseidbuffer{$coursehombuf{$crsid}}) { $courseidbuffer{$coursehombuf{$crsid}}.='&'. &escape($crsid).'='.&escape($coursedescrbuf{$crsid}). - '='.&escape($courseinstcodebuf{$crsid}); + ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}); } else { $courseidbuffer{$coursehombuf{$crsid}}= &escape($crsid).'='.&escape($coursedescrbuf{$crsid}). - '='.&escape($courseinstcodebuf{$crsid}); - } + ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}); + } } # # Write course id database (reverse lookup) to homeserver of courses @@ -1570,6 +1551,8 @@ sub courselog { $ENV{'course.'.$ENV{'request.course.id'}.'.description'}; $courseinstcodebuf{$ENV{'request.course.id'}}= $ENV{'course.'.$ENV{'request.course.id'}.'.internal.coursecode'}; + $courseownerbuf{$ENV{'request.course.id'}}= + $ENV{'course.'.$ENV{'request.course.id'}.'.internal.courseowner'}; if (defined $courselogs{$ENV{'request.course.id'}}) { $courselogs{$ENV{'request.course.id'}}.='&'.$what; } else { @@ -1586,11 +1569,23 @@ sub courseacclog { my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'}; if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|page)$/) { $what.=':POST'; + # FIXME: Probably ought to escape things.... foreach (keys %ENV) { if ($_=~/^form\.(.*)/) { $what.=':'.$1.'='.$ENV{$_}; } } + } elsif ($fnsymb =~ m:^/adm/searchcat:) { + # FIXME: We should not be depending on a form parameter that someone + # editing lonsearchcat.pm might change in the future. + if ($ENV{'form.phase'} eq 'course_search') { + $what.= ':POST'; + # FIXME: Probably ought to escape things.... + foreach my $element ('courseexp','crsfulltext','crsrelated', + 'crsdiscuss') { + $what.=':'.$element.'='.$ENV{'form.'.$element}; + } + } } &courselog($what); } @@ -1642,6 +1637,7 @@ sub get_course_adv_roles { if (($tend) && ($tend<$now)) { next; } if (($tstart) && ($now<$tstart)) { next; } my ($role,$username,$domain,$section)=split(/\:/,$_); + if ($username eq '' || $domain eq '') { next; } if ((&privileged($username,$domain)) && (!$nothide{$username.':'.$domain})) { next; } my $key=&plaintext($role); @@ -1713,7 +1709,7 @@ sub courseidput { } sub courseiddump { - my ($domfilter,$descfilter,$sincefilter,$hostidflag,$hostidref)=@_; + my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$hostidflag,$hostidref)=@_; my %returnhash=(); unless ($domfilter) { $domfilter=''; } foreach my $tryserver (keys %libserv) { @@ -1721,7 +1717,8 @@ sub courseiddump { if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) { foreach ( split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'. - $sincefilter.':'.&escape($descfilter), + $sincefilter.':'.&escape($descfilter).':'. + &escape($instcodefilter).':'.&escape($ownerfilter), $tryserver))) { my ($key,$value)=split(/\=/,$_); if (($key) && ($value)) { @@ -1742,19 +1739,27 @@ sub get_first_access { my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser(); if ($argsymb) { $symb=$argsymb; } my ($map,$id,$res)=&decode_symb($symb); - if ($type eq 'map') { $res=$map; } - my %times=&get('firstaccesstimes',[$res],$udom,$uname); - return $times{$res}; + if ($type eq 'map') { + $res=&symbread($map); + } else { + $res=$symb; + } + my %times=&get('firstaccesstimes',["$courseid\0$res"],$udom,$uname); + return $times{"$courseid\0$res"}; } sub set_first_access { my ($type)=@_; my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser(); my ($map,$id,$res)=&decode_symb($symb); - if ($type eq 'map') { $res=$map; } - my $firstaccess=&get_first_access($type); + if ($type eq 'map') { + $res=&symbread($map); + } else { + $res=$symb; + } + my $firstaccess=&get_first_access($type,$symb); if (!$firstaccess) { - return &put('firstaccesstimes',{$res=>time},$udom,$uname); + return &put('firstaccesstimes',{"$courseid\0$res"=>time},$udom,$uname); } return 'already_set'; } @@ -2095,9 +2100,11 @@ sub tmpreset { $namespace=~s/\//\_/g; $namespace=~s/\W//g; - #FIXME needs to do something for /pub resources if (!$domain) { $domain=$ENV{'user.domain'}; } if (!$stuname) { $stuname=$ENV{'user.name'}; } + if ($domain eq 'public' && $stuname eq 'public') { + $stuname=$ENV{'REMOTE_ADDR'}; + } my $path=$perlvar{'lonDaemons'}.'/tmp'; my %hash; if (tie(%hash,'GDBM_File', @@ -2130,9 +2137,11 @@ sub tmpstore { } $namespace=~s/\//\_/g; $namespace=~s/\W//g; -#FIXME needs to do something for /pub resources if (!$domain) { $domain=$ENV{'user.domain'}; } if (!$stuname) { $stuname=$ENV{'user.name'}; } + if ($domain eq 'public' && $stuname eq 'public') { + $stuname=$ENV{'REMOTE_ADDR'}; + } my $now=time; my %hash; my $path=$perlvar{'lonDaemons'}.'/tmp'; @@ -2144,7 +2153,7 @@ sub tmpstore { my $allkeys=''; foreach my $key (keys(%$storehash)) { $allkeys.=$key.':'; - $hash{"$version:$symb:$key"}=$$storehash{$key}; + $hash{"$version:$symb:$key"}=&freeze_escape($$storehash{$key}); } $hash{"$version:$symb:timestamp"}=$now; $allkeys.='timestamp'; @@ -2171,10 +2180,12 @@ sub tmprestore { $symb=escape($symb); if (!$namespace) { $namespace=$ENV{'request.state'}; } - #FIXME needs to do something for /pub resources + if (!$domain) { $domain=$ENV{'user.domain'}; } if (!$stuname) { $stuname=$ENV{'user.name'}; } - + if ($domain eq 'public' && $stuname eq 'public') { + $stuname=$ENV{'REMOTE_ADDR'}; + } my %returnhash; $namespace=~s/\//\_/g; $namespace=~s/\W//g; @@ -2192,8 +2203,8 @@ sub tmprestore { my $key; $returnhash{"$scope:keys"}=$vkeys; foreach $key (@keys) { - $returnhash{"$scope:$key"}=$hash{"$scope:$symb:$key"}; - $returnhash{"$key"}=$hash{"$scope:$symb:$key"}; + $returnhash{"$scope:$key"}=&thaw_unescape($hash{"$scope:$symb:$key"}); + $returnhash{"$key"}=&thaw_unescape($hash{"$scope:$symb:$key"}); } } if (!(untie(%hash))) { @@ -2234,7 +2245,7 @@ sub store { my $namevalue=''; foreach (keys %$storehash) { - $namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; + $namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&'; } $namevalue=~s/\&$//; &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue); @@ -2270,7 +2281,7 @@ sub cstore { my $namevalue=''; foreach (keys %$storehash) { - $namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; + $namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&'; } $namevalue=~s/\&$//; &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue); @@ -2304,7 +2315,7 @@ sub restore { my %returnhash=(); foreach (split(/\&/,$answer)) { my ($name,$value)=split(/\=/,$_); - $returnhash{&unescape($name)}=&unescape($value); + $returnhash{&unescape($name)}=&thaw_unescape($value); } my $version; for ($version=1;$version<=$returnhash{'version'};$version++) { @@ -2360,7 +2371,7 @@ sub privileged { my $now=time; if ($rolesdump ne '') { foreach (split(/&/,$rolesdump)) { - if ($_!~/^rolesdef\&/) { + if ($_!~/^rolesdef_/) { my ($area,$role)=split(/=/,$_); $area=~s/\_\w\w$//; my ($trole,$tend,$tstart)=split(/_/,$role); @@ -2392,11 +2403,18 @@ sub rolesinit { if ($rolesdump ne '') { foreach (split(/&/,$rolesdump)) { - if ($_!~/^rolesdef\&/) { + if ($_!~/^rolesdef_/) { my ($area,$role)=split(/=/,$_); - $area=~s/\_\w\w$//; - my ($trole,$tend,$tstart)=split(/_/,$role); - $userroles.=&set_arearole($trole,$area,$tstart,$tend); + $area=~s/\_\w\w$//; + + my ($trole,$tend,$tstart); + if ($role=~/^cr/) { + ($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|); + ($tend,$tstart)=split('_',$trest); + } else { + ($trole,$tend,$tstart)=split(/_/,$role); + } + $userroles.=&set_arearole($trole,$area,$tstart,$tend,$domain,$username); if (($tend!=0) && ($tend<$now)) { $trole=''; } if (($tstart!=0) && ($tstart>$now)) { $trole=''; } if (($area ne '') && ($trole ne '')) { @@ -2688,7 +2706,7 @@ sub putstore { my $key = $1.':keys:'.$2; $allitems{$key} .= $3.':'; } - $items.=$_.'='.&escape($$storehash{$_}).'&'; + $items.=$_.'='.&freeze_escape($$storehash{$_}).'&'; } foreach (keys %allitems) { $allitems{$_} =~ s/\:$//; @@ -2773,7 +2791,7 @@ sub customaccess { # ------------------------------------------------- Check for a user privilege sub allowed { - my ($priv,$uri)=@_; + my ($priv,$uri,$symb)=@_; $uri=&deversion($uri); my $orguri=$uri; $uri=&declutter($uri); @@ -3054,7 +3072,7 @@ sub allowed { if ($thisallowed=~/X/) { if ($ENV{'acc.randomout'}) { - my $symb=&symbread($uri,1); + if (!$symb) { $symb=&symbread($uri,1); } if (($symb) && ($ENV{'acc.randomout'}=~/\&\Q$symb\E\&/)) { return ''; } @@ -3356,11 +3374,18 @@ sub auto_instcode_format { my $courses = ''; my $homeserver; if ($caller eq 'global') { - $homeserver = $perlvar{'lonHostID'}; + foreach my $tryserver (keys %libserv) { + if ($hostdom{$tryserver} eq $codedom) { + $homeserver = $tryserver; + last; + } + } + if (($ENV{'user.name'}) && ($ENV{'user.domain'} eq $codedom)) { + $homeserver = &homeserver($ENV{'user.name'},$codedom); + } } else { $homeserver = &homeserver($caller,$codedom); } - my $host=$hostname{$homeserver}; foreach (keys %{$instcodes}) { $courses .= &escape($_).'='.&escape($$instcodes{$_}).'&'; } @@ -3687,7 +3712,7 @@ sub writecoursepref { # ---------------------------------------------------------- Make/modify course sub createcourse { - my ($udom,$description,$url,$course_server,$nonstandard,$inst_code)=@_; + my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,$course_owner)=@_; $url=&declutter($url); my $cid=''; unless (&allowed('ccc',$udom)) { @@ -3722,7 +3747,7 @@ sub createcourse { # ----------------------------------------------------------------- Course made # log existence &courseidput($udom,&escape($udom.'_'.$uname).'='.&escape($description). - '='.&escape($inst_code),$uhome); + ':'.&escape($inst_code).':'.&escape($course_owner),$uhome); &flushcourselogs(); # set toplevel url my $topurl=$url; @@ -3809,6 +3834,75 @@ sub mark_as_readonly { return; } +# ------------------------------------------------------------Save Selected Files + +sub save_selected_files { + my ($user, $path, @files) = @_; + my $filename = $user."savedfiles"; + my @other_files = &files_not_in_path($user, $path); + open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename); + foreach my $file (@files) { + print (OUT $ENV{'form.currentpath'}.$file."\n"); + } + foreach my $file (@other_files) { + print (OUT $file."\n"); + } + close (OUT); + return 'ok'; +} + +sub clear_selected_files { + my ($user) = @_; + my $filename = $user."savedfiles"; + open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename); + print (OUT undef); + close (OUT); + return ("ok"); +} + +sub files_in_path { + my ($user, $path) = @_; + my $filename = $user."savedfiles"; + my %return_files; + open (IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename); + while (my $line_in = ) { + chomp ($line_in); + my @paths_and_file = split (m!/!, $line_in); + my $file_part = pop (@paths_and_file); + my $path_part = join ('/', @paths_and_file); + $path_part.='/'; + my $path_and_file = $path_part.$file_part; + if ($path_part eq $path) { + $return_files{$file_part}= 'selected'; + } + } + close (IN); + return (\%return_files); +} + +# called in portfolio select mode, to show files selected NOT in current directory +sub files_not_in_path { + my ($user, $path) = @_; + my $filename = $user."savedfiles"; + my @return_files; + my $path_part; + open (IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename); + while () { + #ok, I know it's clunky, but I want it to work + my @paths_and_file = split m!/!, $_; + my $file_part = pop (@paths_and_file); + chomp ($file_part); + my $path_part = join ('/', @paths_and_file); + $path_part .= '/'; + my $path_and_file = $path_part.$file_part; + if ($path_part ne $path) { + push (@return_files, ($path_and_file)); + } + } + close (OUT); + return (@return_files); +} + #--------------------------------------------------------------Get Marked as Read Only sub get_marked_as_readonly { @@ -3828,7 +3922,25 @@ sub get_marked_as_readonly { } return @readonly_files; } +#-----------------------------------------------------------Get Marked as Read Only Hash +sub get_marked_as_readonly_hash { + my ($domain,$user,$what) = @_; + my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user); + my %readonly_files; + while (my ($file_name,$value) = each(%current_permissions)) { + if (ref($value) eq "ARRAY"){ + foreach my $stored_what (@{$value}) { + if ($stored_what eq $what) { + $readonly_files{$file_name} = 'locked'; + } elsif (!defined($what)) { + $readonly_files{$file_name} = 'locked'; + } + } + } + } + return %readonly_files; +} # ------------------------------------------------------------ Unmark as Read Only sub unmark_as_readonly { @@ -4340,6 +4452,7 @@ sub packages_tab_default { if (defined($packagetab{"$pack_type&$name&default"})) { return $packagetab{"$pack_type&$name&default"}; } + if ($pack_type eq 'part') { $pack_part='0'; } if (defined($packagetab{$pack_type."_".$pack_part."&$name&default"})) { return $packagetab{$pack_type."_".$pack_part."&$name&default"}; } @@ -4621,7 +4734,9 @@ sub gettitle { my $symb=&symbread($urlsymb); if ($symb) { my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600); - if (defined($cached)) { return $result; } + if (defined($cached)) { + return $result; + } my ($map,$resid,$url)=&decode_symb($symb); my $title=''; my %bighash; @@ -4697,8 +4812,11 @@ sub symbverify { if ( &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) eq $symb) { - $okay=1; - } + if (($ENV{'request.role.adv'}) || + $bighash{'encrypted_'.$_} eq $ENV{'request.enc'}) { + $okay=1; + } + } } } untie(%bighash); @@ -4710,7 +4828,7 @@ sub symbverify { sub symbclean { my $symb=shift; - + if ($symb=~m|^/enc/|) { $symb=&Apache::lonenc::unencrypted($symb); } # remove version from map $symb=~s/\.(\d+)\.(\w+)\_\_\_/\.$2\_\_\_/; @@ -4731,7 +4849,9 @@ sub encode_symb { } sub decode_symb { - my ($map,$resid,$url)=split(/\_\_\_/,shift); + my $symb=shift; + if ($symb=~m|^/enc/|) { $symb=&Apache::lonenc::unencrypted($symb); } + my ($map,$resid,$url)=split(/___/,$symb); return (&fixversion($map),$resid,&fixversion($url)); } @@ -4780,6 +4900,7 @@ sub symbread { } $thisfn=$ENV{'request.filename'}; } + if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); } # is that filename actually a symb? Verify, clean, and return if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) { if (&symbverify($thisfn,$1)) { @@ -4890,8 +5011,25 @@ sub numval2 { return int($total); } +sub numval3 { + use integer; + my $txt=shift; + $txt=~tr/A-J/0-9/; + $txt=~tr/a-j/0-9/; + $txt=~tr/K-T/0-9/; + $txt=~tr/k-t/0-9/; + $txt=~tr/U-Z/0-5/; + $txt=~tr/u-z/0-5/; + $txt=~s/\D//g; + my @txts=split(/(\d\d\d\d\d\d\d\d\d)/,$txt); + my $total; + foreach my $val (@txts) { $total+=$val; } + if ($_64bit) { $total=(($total<<32)>>32); } + return $total; +} + sub latest_rnd_algorithm_id { - return '64bit3'; + return '64bit4'; } sub get_rand_alg { @@ -4930,7 +5068,13 @@ sub rndseed { if (!$username) { $username=$wusername } my $which=&get_rand_alg(); if (defined(&getCODE())) { - return &rndseed_CODE_64bit($symb,$courseid,$domain,$username); + if ($which eq '64bit4') { + return &rndseed_CODE_64bit4($symb,$courseid,$domain,$username); + } else { + return &rndseed_CODE_64bit($symb,$courseid,$domain,$username); + } + } elsif ($which eq '64bit4') { + return &rndseed_64bit4($symb,$courseid,$domain,$username); } elsif ($which eq '64bit3') { return &rndseed_64bit3($symb,$courseid,$domain,$username); } elsif ($which eq '64bit2') { @@ -5027,6 +5171,30 @@ sub rndseed_64bit3 { } } +sub rndseed_64bit4 { + my ($symb,$courseid,$domain,$username)=@_; + { + use integer; + # strings need to be an even # of cahracters long, it it is odd the + # last characters gets thrown away + my $symbchck=unpack("%32S*",$symb.' ') << 21; + my $symbseed=numval3($symb) << 10; + my $namechck=unpack("%32S*",$username.' '); + + my $nameseed=numval3($username) << 21; + my $domainseed=unpack("%32S*",$domain.' ') << 10; + my $courseseed=unpack("%32S*",$courseid.' '); + + my $num1=$symbchck+$symbseed+$namechck; + my $num2=$nameseed+$domainseed+$courseseed; + #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); + #&Apache::lonxml::debug("rndseed :$num1:$num2:$_64bit"); + if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } + + return "$num1:$num2"; + } +} + sub rndseed_CODE_64bit { my ($symb,$courseid,$domain,$username)=@_; { @@ -5046,6 +5214,25 @@ sub rndseed_CODE_64bit { } } +sub rndseed_CODE_64bit4 { + my ($symb,$courseid,$domain,$username)=@_; + { + use integer; + my $symbchck=unpack("%32S*",$symb.' ') << 16; + my $symbseed=numval3($symb); + my $CODEchck=unpack("%32S*",&getCODE().' ') << 16; + my $CODEseed=numval3(&getCODE()); + my $courseseed=unpack("%32S*",$courseid.' '); + my $num1=$symbseed+$CODEchck; + my $num2=$CODEseed+$courseseed+$symbchck; + #&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck"); + #&Apache::lonxml::debug("rndseed :$num1:$num2:$symb"); + if ($_64bit) { $num1=(($num1<<32)>>32); } + if ($_64bit) { $num2=(($num2<<32)>>32); } + return "$num1:$num2"; + } +} + sub setup_random_from_rndseed { my ($rndseed)=@_; if ($rndseed =~/([,:])/) { @@ -5252,39 +5439,42 @@ sub readfile { } sub filelocation { - my ($dir,$file) = @_; - my $location; - $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces - if ($file=~m:^/~:) { # is a contruction space reference - $location = $file; - $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; - } elsif ($file=~/^\/*uploaded/) { # is an uploaded file - my ($udom,$uname,$filename)= - ($file=~m|^/+uploaded/+([^/]+)/+([^/]+)/+(.*)$|); - my $home=&homeserver($uname,$udom); - my $is_me=0; - my @ids=¤t_machine_ids(); - foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } } - if ($is_me) { - $location=&Apache::loncommon::propath($udom,$uname). - '/userfiles/'.$filename; - } else { - $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'. - $udom.'/'.$uname.'/'.$filename; - } - } else { - $file=~s/^\Q$perlvar{'lonDocRoot'}\E//; - $file=~s:^/res/:/:; - if ( !( $file =~ m:^/:) ) { - $location = $dir. '/'.$file; - } else { - $location = '/home/httpd/html/res'.$file; + my ($dir,$file) = @_; + my $location; + $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces + if ($file=~m:^/~:) { # is a contruction space reference + $location = $file; + $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; + } elsif ($file=~/^\/*uploaded/) { # is an uploaded file + my ($udom,$uname,$filename)= + ($file=~m|^/+uploaded/+([^/]+)/+([^/]+)/+(.*)$|); + my $home=&homeserver($uname,$udom); + my $is_me=0; + my @ids=¤t_machine_ids(); + foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } } + if ($is_me) { + $location=&Apache::loncommon::propath($udom,$uname). + '/userfiles/'.$filename; + } else { + $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'. + $udom.'/'.$uname.'/'.$filename; + } + } elsif ($file =~ /^\/adm\/portfolio\//) { + $file =~ s:^/adm/portfolio/::; + $location = $location=&Apache::loncommon::propath($ENV{'user.domain'},$ENV{'user.name'}).'/userfiles/portfolio/'.$file; + } else { + $file=~s/^\Q$perlvar{'lonDocRoot'}\E//; + $file=~s:^/res/:/:; + if ( !( $file =~ m:^/:) ) { + $location = $dir. '/'.$file; + } else { + $location = '/home/httpd/html/res'.$file; + } } - } - $location=~s://+:/:g; # remove duplicate / - while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/.. - while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./ - return $location; + $location=~s://+:/:g; # remove duplicate / + while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/.. + while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./ + return $location; } sub hreflocation { @@ -5330,6 +5520,7 @@ sub current_machine_ids { sub declutter { my $thisfn=shift; + if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); } $thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//; $thisfn=~s/^\///; $thisfn=~s/^res\///; @@ -5383,10 +5574,10 @@ sub thaw_unescape { } sub mod_perl_version { + return 1; if (defined($perlvar{'MODPERL2'})) { return 2; } - return 1; } sub correct_line_ends { @@ -5419,6 +5610,7 @@ BEGIN { # ----------------------------------- Read loncapa.conf and loncapa_apache.conf unless ($readit) { { + # FIXME: Use LONCAPA::Configuration::read_conf here and omit next block open(my $config,") { @@ -5565,7 +5757,7 @@ $readit=1; { use integer; my $test=(2**32)+1; - if ($test != 0) { $_64bit=1; } + if ($test != 0) { $_64bit=1; } else { $_64bit=0; } &logthis(" Detected 64bit platform ($_64bit)"); } } @@ -6054,9 +6246,10 @@ returns the data handle =item * symbverify($symb,$thisfn) : verifies that $symb actually exists and is -a possible symb for the URL in $thisfn, returns a 1 on success, 0 on -failure, user must be in a course, as it assumes the existance of the -course initi hash, and uses $ENV('request.course.id'} +a possible symb for the URL in $thisfn, and if is an encryypted +resource that the user accessed using /enc/ returns a 1 on success, 0 +on failure, user must be in a course, as it assumes the existance of +the course initial hash, and uses $ENV('request.course.id'} =item *