--- loncom/lonnet/perl/lonnet.pm 2010/10/27 01:00:44 1.1090 +++ loncom/lonnet/perl/lonnet.pm 2011/01/22 00:46:15 1.1102 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1090 2010/10/27 01:00:44 raeburn Exp $ +# $Id: lonnet.pm,v 1.1102 2011/01/22 00:46:15 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2176,6 +2176,8 @@ sub allowuploaded { # path to file, source of file, instruction to parse file for objects, # ref to hash for embedded objects, # ref to hash for codebase of java objects. +# reference to scalar to accommodate mime type determined +# from File::MMagic if $parser = parse. # # output: url to file (if action was uploaddoc), # ok if successful, or diagnostic message otherwise (if action was propagate or copy) @@ -2202,7 +2204,8 @@ sub allowuploaded { # sub process_coursefile { - my ($action,$docuname,$docudom,$file,$source,$parser,$allfiles,$codebase)=@_; + my ($action,$docuname,$docudom,$file,$source,$parser,$allfiles,$codebase, + $mimetype)=@_; my $fetchresult; my $home=&homeserver($docuname,$docudom); if ($action eq 'propagate') { @@ -2230,13 +2233,16 @@ sub process_coursefile { close($fh); if ($parser eq 'parse') { my $mm = new File::MMagic; - my $mime_type = $mm->checktype_filename($filepath.'/'.$fname); - if ($mime_type eq 'text/html') { + my $type = $mm->checktype_filename($filepath.'/'.$fname); + if ($type eq 'text/html') { my $parse_result = &extract_embedded_items($filepath.'/'.$fname,$allfiles,$codebase); unless ($parse_result eq 'ok') { &logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result); } } + if (ref($mimetype)) { + $$mimetype = $type; + } } $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, $home); @@ -2352,7 +2358,7 @@ sub resizeImage { # --------------- Take an uploaded file and put it into the userfiles directory # input: $formname - the contents of the file are in $env{"form.$formname"} -# the desired filenam is in $env{"form.$formname.filename"} +# the desired filename is in $env{"form.$formname.filename"} # $context - possible values: coursedoc, existingfile, overwrite, # canceloverwrite, or ''. # if 'coursedoc': upload to the current course @@ -2369,26 +2375,27 @@ sub resizeImage { # $thumbheight - height (pixels) of thumbnail to make for uploaded image # $resizewidth - width (pixels) to which to resize uploaded image # $resizeheight - height (pixels) to which to resize uploaded image +# $mimetype - reference to scalar to accommodate mime type determined +# from File::MMagic if $parser = parse. # # output: url of file in userspace, or error: # or /adm/notfound.html if failure to upload occurse sub userfileupload { my ($formname,$context,$subdir,$parser,$allfiles,$codebase,$destuname, - $destudom,$thumbwidth,$thumbheight,$resizewidth,$resizeheight)=@_; + $destudom,$thumbwidth,$thumbheight,$resizewidth,$resizeheight,$mimetype)=@_; if (!defined($subdir)) { $subdir='unknown'; } my $fname=$env{'form.'.$formname.'.filename'}; $fname=&clean_filename($fname); # See if there is anything left unless ($fname) { return 'error: no uploaded file'; } - chop($env{'form.'.$formname}); # Files uploaded to help request form, or uploaded to "create course" page are handled differently if ((($formname eq 'screenshot') && ($subdir eq 'helprequests')) || (($formname eq 'coursecreatorxml') && ($subdir eq 'batchupload')) || ($context eq 'existingfile') || ($context eq 'canceloverwrite')) { my $now = time; my $filepath; - if (($formname eq 'screenshot') && ($subdir eq 'helprequests')) { + if (($formname eq 'screenshot') && ($subdir eq 'helprequests')) { $filepath = 'tmp/helprequests/'.$now; } elsif (($formname eq 'coursecreatorxml') && ($subdir eq 'batchupload')) { $filepath = 'tmp/addcourse/'.$destudom.'/web/'.$env{'user.name'}. @@ -2442,7 +2449,7 @@ sub userfileupload { } if ($subdir eq 'scantron') { $fname = 'scantron_orig_'.$fname; - } else { + } else { $fname="$subdir/$fname"; } if ($context eq 'coursedoc') { @@ -2452,12 +2459,12 @@ sub userfileupload { return &finishuserfileupload($docuname,$docudom, $formname,$fname,$parser,$allfiles, $codebase,$thumbwidth,$thumbheight, - $resizewidth,$resizeheight,$context); + $resizewidth,$resizeheight,$context,$mimetype); } else { $fname=$env{'form.folder'}.'/'.$fname; return &process_coursefile('uploaddoc',$docuname,$docudom, $fname,$formname,$parser, - $allfiles,$codebase); + $allfiles,$codebase,$mimetype); } } elsif (defined($destuname)) { my $docuname=$destuname; @@ -2465,7 +2472,7 @@ sub userfileupload { return &finishuserfileupload($docuname,$docudom,$formname,$fname, $parser,$allfiles,$codebase, $thumbwidth,$thumbheight, - $resizewidth,$resizeheight,$context); + $resizewidth,$resizeheight,$context,$mimetype); } else { my $docuname=$env{'user.name'}; my $docudom=$env{'user.domain'}; @@ -2476,13 +2483,13 @@ sub userfileupload { return &finishuserfileupload($docuname,$docudom,$formname,$fname, $parser,$allfiles,$codebase, $thumbwidth,$thumbheight, - $resizewidth,$resizeheight,$context); + $resizewidth,$resizeheight,$context,$mimetype); } } sub finishuserfileupload { my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase, - $thumbwidth,$thumbheight,$resizewidth,$resizeheight,$context) = @_; + $thumbwidth,$thumbheight,$resizewidth,$resizeheight,$context,$mimetype) = @_; my $path=$docudom.'/'.$docuname.'/'; my $filepath=$perlvar{'lonDocRoot'}; @@ -2540,8 +2547,8 @@ sub finishuserfileupload { } if ($parser eq 'parse') { my $mm = new File::MMagic; - my $mime_type = $mm->checktype_filename($filepath.'/'.$file); - if ($mime_type eq 'text/html') { + my $type = $mm->checktype_filename($filepath.'/'.$file); + if ($type eq 'text/html') { my $parse_result = &extract_embedded_items($filepath.'/'.$file, $allfiles,$codebase); unless ($parse_result eq 'ok') { @@ -2549,6 +2556,9 @@ sub finishuserfileupload { ' for embedded media: '.$parse_result); } } + if (ref($mimetype)) { + $$mimetype = $type; + } } if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) { my $input = $filepath.'/'.$file; @@ -4428,15 +4438,18 @@ sub dump { my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range:$extra",$uhome); my @pairs=split(/\&/,$rep); my %returnhash=(); - foreach my $item (@pairs) { - my ($key,$value)=split(/=/,$item,2); - $key = &unescape($key); - next if ($key =~ /^error: 2 /); - $returnhash{$key}=&thaw_unescape($value); + if (!($rep =~ /^error/ )) { + foreach my $item (@pairs) { + my ($key,$value)=split(/=/,$item,2); + $key = &unescape($key); + next if ($key =~ /^error: 2 /); + $returnhash{$key}=&thaw_unescape($value); + } } return %returnhash; } + # --------------------------------------------------------- dumpstore interface sub dumpstore { @@ -6012,9 +6025,9 @@ sub auto_get_sections { } sub auto_new_course { - my ($cnum,$cdom,$inst_course_id,$owner) = @_; + my ($cnum,$cdom,$inst_course_id,$owner,$coowners) = @_; my $homeserver = &homeserver($cnum,$cdom); - my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.$owner.':'.$cdom,$homeserver)); + my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.&escape($owner).':'.$cdom.':'.&escape($coowners),$homeserver)); return $response; } @@ -7285,10 +7298,10 @@ sub diskusage { } sub is_locked { - my ($file_name, $domain, $user) = @_; + my ($file_name, $domain, $user, $which) = @_; my @check; my $is_locked; - push @check, $file_name; + push (@check,$file_name); my %locked = &get('file_permissions',\@check, $env{'user.domain'},$env{'user.name'}); my ($tmp)=keys(%locked); @@ -7297,14 +7310,19 @@ sub is_locked { if (ref($locked{$file_name}) eq 'ARRAY') { $is_locked = 'false'; foreach my $entry (@{$locked{$file_name}}) { - if (ref($entry) eq 'ARRAY') { + if (ref($entry) eq 'ARRAY') { $is_locked = 'true'; - last; + if (ref($which) eq 'ARRAY') { + push(@{$which},$entry); + } else { + last; + } } } } else { $is_locked = 'false'; } + return $is_locked; } sub declutter_portfile { @@ -8455,7 +8473,7 @@ sub metadata { if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) || - ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^\*uploaded\/.+\.sequence$/) ) { + ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$}) || ($uri =~ m{^/*uploaded/$match_domain/$match_courseid/docs/})) { return undef; } if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) @@ -8900,8 +8918,9 @@ sub symbverify { $thisurl =~ s/\?.+$//; } my $ids=$bighash{'ids_'.&clutter($thisurl)}; - unless ($ids) { - $ids=$bighash{'ids_/'.$thisurl}; + unless ($ids) { + my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl; + $ids=$bighash{$idkey}; } if ($ids) { # ------------------------------------------------------------------- Has ID(s) @@ -8914,7 +8933,8 @@ sub symbverify { &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) eq $symb) { if (($env{'request.role.adv'}) || - $bighash{'encrypted_'.$id} eq $env{'request.enc'}) { + ($bighash{'encrypted_'.$id} eq $env{'request.enc'}) || + ($thisurl eq '/adm/navmaps')) { $okay=1; } } @@ -11437,6 +11457,8 @@ userspace, probably shouldn't be called resizeheight: height to be used to resize image using resizeImage from ImageMagick context: if 'overwrite', will move the uploaded file from its temporary location to userfiles to facilitate overwriting a previously uploaded file with same name. + mimetype: reference to scalar to accommodate mime type determined + from File::MMagic if $parser = parse. returns either the url of the uploaded file (/uploaded/....) if successful and /adm/notfound.html if unsuccessful (or an error message if context