--- loncom/lonnet/perl/lonnet.pm 2010/12/24 21:59:08 1.1056.4.15 +++ loncom/lonnet/perl/lonnet.pm 2011/01/25 09:56:17 1.1056.4.21 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1056.4.15 2010/12/24 21:59:08 raeburn Exp $ +# $Id: lonnet.pm,v 1.1056.4.21 2011/01/25 09:56:17 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2200,6 +2200,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) @@ -2226,7 +2228,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') { @@ -2254,13 +2257,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); @@ -2393,13 +2399,15 @@ 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); @@ -2475,12 +2483,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; @@ -2488,7 +2496,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'}; @@ -2499,13 +2507,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'}; @@ -2563,8 +2571,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') { @@ -2572,6 +2580,9 @@ sub finishuserfileupload { ' for embedded media: '.$parse_result); } } + if (ref($mimetype)) { + $$mimetype = $type; + } } if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) { my $input = $filepath.'/'.$file; @@ -6120,9 +6131,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; } @@ -7393,7 +7404,7 @@ 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); @@ -7405,9 +7416,13 @@ 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 { @@ -8563,7 +8578,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/}) @@ -8953,7 +8968,8 @@ sub symbverify { } my $ids=$bighash{'ids_'.&clutter($thisurl)}; unless ($ids) { - $ids=$bighash{'ids_/'.$thisurl}; + my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl; + $ids=$bighash{$idkey}; } if ($ids) { # ------------------------------------------------------------------- Has ID(s) @@ -8966,7 +8982,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; } } @@ -11489,6 +11506,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