--- loncom/lonnet/perl/lonnet.pm 2012/03/14 20:53:50 1.1158 +++ loncom/lonnet/perl/lonnet.pm 2012/12/31 14:59:54 1.1172.2.15 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1158 2012/03/14 20:53:50 www Exp $ +# $Id: lonnet.pm,v 1.1172.2.15 2012/12/31 14:59:54 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -96,6 +96,7 @@ use Math::Random; use File::MMagic; use LONCAPA qw(:DEFAULT :match); use LONCAPA::Configuration; +use LONCAPA::lonmetadata; use File::Copy; @@ -107,31 +108,33 @@ require Exporter; our @ISA = qw (Exporter); our @EXPORT = qw(%env); - -# --------------------------------------------------------------------- Logging +# ------------------------------------ Logging (parameters, docs, slots, roles) { my $logid; - sub instructor_log { - my ($hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_; - if (($cnum eq '') || ($cdom eq '')) { - $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + sub write_log { + my ($context,$hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_; + if ($context eq 'course') { + if (($cnum eq '') || ($cdom eq '')) { + $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + } } - $logid++; + $logid ++; my $now = time(); my $id=$now.'00000'.$$.'00000'.$logid; - return &Apache::lonnet::put('nohist_'.$hash_name, - { $id => { - 'exe_uname' => $env{'user.name'}, - 'exe_udom' => $env{'user.domain'}, - 'exe_time' => $now, - 'exe_ip' => $ENV{'REMOTE_ADDR'}, - 'delflag' => $delflag, - 'logentry' => $storehash, - 'uname' => $uname, - 'udom' => $udom, - } - },$cdom,$cnum); + my $logentry = { + $id => { + 'exe_uname' => $env{'user.name'}, + 'exe_udom' => $env{'user.domain'}, + 'exe_time' => $now, + 'exe_ip' => $ENV{'REMOTE_ADDR'}, + 'delflag' => $delflag, + 'logentry' => $storehash, + 'uname' => $uname, + 'udom' => $udom, + } + }; + return &put('nohist_'.$hash_name,$logentry,$cdom,$cnum); } } @@ -1232,9 +1235,10 @@ sub get_lonbalancer_config { sub check_loadbalancing { my ($uname,$udom) = @_; - my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect, - $offloadto,$otherserver); + my ($is_balancer,$currtargets,$currrules,$dom_in_use,$homeintdom, + $rule_in_effect,$offloadto,$otherserver); my $lonhost = $perlvar{'lonHostID'}; + my @hosts = ¤t_machine_ids(); my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); my $uintdom = &Apache::lonnet::internet_dom($uprimary_id); my $intdom = &Apache::lonnet::internet_dom($lonhost); @@ -1257,15 +1261,8 @@ sub check_loadbalancing { } } if (ref($result) eq 'HASH') { - my $currbalancer = $result->{'lonhost'}; - my $currtargets = $result->{'targets'}; - my $currrules = $result->{'rules'}; - if ($currbalancer ne '') { - my @hosts = ¤t_machine_ids(); - if (grep(/^\Q$currbalancer\E$/,@hosts)) { - $is_balancer = 1; - } - } + ($is_balancer,$currtargets,$currrules) = + &check_balancer_result($result,@hosts); if ($is_balancer) { if (ref($currrules) eq 'HASH') { if ($homeintdom) { @@ -1323,12 +1320,9 @@ sub check_loadbalancing { } } if (ref($result) eq 'HASH') { - my $currbalancer = $result->{'lonhost'}; - my $currtargets = $result->{'targets'}; - my $currrules = $result->{'rules'}; - - if ($currbalancer eq $lonhost) { - $is_balancer = 1; + ($is_balancer,$currtargets,$currrules) = + &check_balancer_result($result,@hosts); + if ($is_balancer) { if (ref($currrules) eq 'HASH') { if ($currrules->{'_LC_internetdom'} ne '') { $rule_in_effect = $currrules->{'_LC_internetdom'}; @@ -1349,41 +1343,81 @@ sub check_loadbalancing { $offloadto = &this_host_spares($dom_in_use); } } - my $lowest_load = 30000; - if (ref($offloadto) eq 'HASH') { - if (ref($offloadto->{'primary'}) eq 'ARRAY') { - foreach my $try_server (@{$offloadto->{'primary'}}) { - ($otherserver,$lowest_load) = - &compare_server_load($try_server,$otherserver,$lowest_load); + if ($is_balancer) { + my $lowest_load = 30000; + if (ref($offloadto) eq 'HASH') { + if (ref($offloadto->{'primary'}) eq 'ARRAY') { + foreach my $try_server (@{$offloadto->{'primary'}}) { + ($otherserver,$lowest_load) = + &compare_server_load($try_server,$otherserver,$lowest_load); + } } - } - my $found_server = ($otherserver ne '' && $lowest_load < 100); + my $found_server = ($otherserver ne '' && $lowest_load < 100); - if (!$found_server) { - if (ref($offloadto->{'default'}) eq 'ARRAY') { - foreach my $try_server (@{$offloadto->{'default'}}) { + if (!$found_server) { + if (ref($offloadto->{'default'}) eq 'ARRAY') { + foreach my $try_server (@{$offloadto->{'default'}}) { + ($otherserver,$lowest_load) = + &compare_server_load($try_server,$otherserver,$lowest_load); + } + } + } + } elsif (ref($offloadto) eq 'ARRAY') { + if (@{$offloadto} == 1) { + $otherserver = $offloadto->[0]; + } elsif (@{$offloadto} > 1) { + foreach my $try_server (@{$offloadto}) { ($otherserver,$lowest_load) = &compare_server_load($try_server,$otherserver,$lowest_load); } } } - } elsif (ref($offloadto) eq 'ARRAY') { - if (@{$offloadto} == 1) { - $otherserver = $offloadto->[0]; - } elsif (@{$offloadto} > 1) { - foreach my $try_server (@{$offloadto}) { - ($otherserver,$lowest_load) = - &compare_server_load($try_server,$otherserver,$lowest_load); + if (($otherserver ne '') && (grep(/^\Q$otherserver\E$/,@hosts))) { + $is_balancer = 0; + if ($uname ne '' && $udom ne '') { + if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) { + + &appenv({'user.loadbalexempt' => $lonhost, + 'user.loadbalcheck.time' => time}); + } } } } return ($is_balancer,$otherserver); } +sub check_balancer_result { + my ($result,@hosts) = @_; + my ($is_balancer,$currtargets,$currrules); + if (ref($result) eq 'HASH') { + if ($result->{'lonhost'} ne '') { + my $currbalancer = $result->{'lonhost'}; + if (grep(/^\Q$currbalancer\E$/,@hosts)) { + $is_balancer = 1; + $currtargets = $result->{'targets'}; + $currrules = $result->{'rules'}; + } + } else { + foreach my $key (keys(%{$result})) { + if (($key ne '') && (grep(/^\Q$key\E$/,@hosts)) && + (ref($result->{$key}) eq 'HASH')) { + $is_balancer = 1; + $currrules = $result->{$key}{'rules'}; + $currtargets = $result->{$key}{'targets'}; + last; + } + } + } + } + return ($is_balancer,$currtargets,$currrules); +} + sub get_loadbalancer_targets { my ($rule_in_effect,$currtargets,$uname,$udom) = @_; my $offloadto; - if ($rule_in_effect eq '') { + if ($rule_in_effect eq 'none') { + return [$perlvar{'lonHostID'}]; + } elsif ($rule_in_effect eq '') { $offloadto = $currtargets; } else { if ($rule_in_effect eq 'homeserver') { @@ -1401,7 +1435,7 @@ sub get_loadbalancer_targets { } } } else { - my %servers = &dom_servers($udom); + my %servers = &internet_dom_servers($udom); my ($remotebalancer,$remotetargets) = &get_lonbalancer_config(\%servers); if (&hostname($remotebalancer) ne '') { $offloadto = [$remotebalancer]; @@ -1534,16 +1568,13 @@ sub idput { # ------------------------------dump from db file owned by domainconfig user sub dump_dom { - my ($namespace,$udom,$regexp,$range)=@_; - if (!$udom) { - $udom=$env{'user.domain'}; - } - my %returnhash; - if ($udom) { - my $uname = &get_domainconfiguser($udom); - %returnhash = &dump($namespace,$udom,$uname,$regexp,$range); - } - return %returnhash; + my ($namespace, $udom, $regexp) = @_; + + $udom ||= $env{'user.domain'}; + + return () unless $udom; + + return &dump($namespace, $udom, &get_domainconfiguser($udom), $regexp); } # ------------------------------------------ get items from domain db files @@ -1923,7 +1954,8 @@ sub get_domain_defaults { my %domconfig = &Apache::lonnet::get_dom('configuration',['defaults','quotas', 'requestcourses','inststatus', - 'coursedefaults','usersessions'],$domain); + 'coursedefaults','usersessions', + 'requestauthor'],$domain); if (ref($domconfig{'defaults'}) eq 'HASH') { $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'}; @@ -1942,7 +1974,7 @@ sub get_domain_defaults { } else { $domdefaults{'defaultquota'} = $domconfig{'quotas'}; } - my @usertools = ('aboutme','blog','portfolio'); + my @usertools = ('aboutme','blog','webdav','portfolio'); foreach my $item (@usertools) { if (ref($domconfig{'quotas'}{$item}) eq 'HASH') { $domdefaults{$item} = $domconfig{'quotas'}{$item}; @@ -1954,6 +1986,9 @@ sub get_domain_defaults { $domdefaults{$item} = $domconfig{'requestcourses'}{$item}; } } + if (ref($domconfig{'requestauthor'}) eq 'HASH') { + $domdefaults{'requestauthor'} = $domconfig{'requestauthor'}; + } if (ref($domconfig{'inststatus'}) eq 'HASH') { foreach my $item ('inststatustypes','inststatusorder') { $domdefaults{$item} = $domconfig{'inststatus'}{$item}; @@ -2157,8 +2192,7 @@ sub getsection { # If there is a role which has expired, return it. # $courseid = &courseid_to_courseurl($courseid); - my $extra = &freeze_escape({'skipcheck' => 1}); - my %roleshash = &dump('roles',$udom,$unam,$courseid,undef,$extra); + my %roleshash = &dump('roles',$udom,$unam,$courseid); foreach my $key (keys(%roleshash)) { next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/); my $section=$1; @@ -2384,7 +2418,7 @@ sub chatsend { sub getversion { my $fname=&clutter(shift); - unless ($fname=~/^\/res\//) { return -1; } + unless ($fname=~m{^(/adm/wrapper|)/res/}) { return -1; } return ¤tversion(&filelocation('',$fname)); } @@ -2442,7 +2476,7 @@ sub repcopy { $filename=~s/\/+/\//g; my $londocroot = $perlvar{'lonDocRoot'}; if ($filename=~m{^\Q$londocroot/adm/\E}) { return 'ok'; } - if ($filename=~m{^\Q$londocroot/lonUsers/\E}) { return 'ok'; } + if ($filename=~m{^\Q/home/httpd/lonUsers/\E}) { return 'ok'; } if ($filename=~m{^\Q$londocroot/userfiles/\E} or $filename=~m{^/*(uploaded|editupload)/}) { return &repcopy_userfile($filename); @@ -2570,8 +2604,7 @@ sub ssi { } $request->header(Cookie => $ENV{'HTTP_COOKIE'}); - my $response=$ua->request($request); - + my $response= $ua->request($request); if (wantarray) { return ($response->content, $response); } else { @@ -2604,6 +2637,253 @@ sub allowuploaded { &Apache::lonnet::appenv(\%httpref); } +# +# Determine if the current user should be able to edit a particular resource, +# when viewing in course context. +# (a) When viewing resource used to determine if "Edit" item is included in +# Functions. +# (b) When displaying folder contents in course editor, used to determine if +# "Edit" link will be displayed alongside resource. +# +# input: six args -- filename (decluttered), course number, course domain, +# url, symb (if registered) and group (if this is a group +# item -- e.g., bulletin board, group page etc.). +# output: array of five scalars -- +# $cfile -- url for file editing if editable on current server +# $home -- homeserver of resource (i.e., for author if published, +# or course if uploaded.). +# $switchserver -- 1 if server switch will be needed. +# $forceedit -- 1 if icon/link should be to go to edit mode +# $forceview -- 1 if icon/link should be to go to view mode +# + +sub can_edit_resource { + my ($file,$cnum,$cdom,$resurl,$symb,$group) = @_; + my ($cfile,$home,$switchserver,$forceedit,$forceview,$uploaded,$incourse); +# +# For aboutme pages user can only edit his/her own. +# + if ($resurl =~ m{^/?adm/($match_domain)/($match_username)/aboutme$}) { + my ($sdom,$sname) = ($1,$2); + if (($sdom eq $env{'user.domain'}) && ($sname eq $env{'user.name'})) { + $home = $env{'user.home'}; + $cfile = $resurl; + if ($env{'form.forceedit'}) { + $forceview = 1; + } else { + $forceedit = 1; + } + return ($cfile,$home,$switchserver,$forceedit,$forceview); + } else { + return; + } + } + + if ($env{'request.course.id'}) { + my $crsedit = &Apache::lonnet::allowed('mdc',$env{'request.course.id'}); + if ($group ne '') { +# if this is a group homepage or group bulletin board, check group privs + my $allowed = 0; + if ($resurl =~ m{^/?adm/$cdom/$cnum/$group/smppg$}) { + if ((&allowed('mdg',$env{'request.course.id'}. + ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) || + (&allowed('mgh',$env{'request.course.id'}.'/'.$group)) || $crsedit) { + $allowed = 1; + } + } elsif ($resurl =~ m{^/?adm/$cdom/$cnum/\d+/bulletinboard$}) { + if ((&allowed('mdg',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) || + (&allowed('cgb',$env{'request.course.id'}.'/'.$group)) || $crsedit) { + $allowed = 1; + } + } + if ($allowed) { + $home=&homeserver($cnum,$cdom); + if ($env{'form.forceedit'}) { + $forceview = 1; + } else { + $forceedit = 1; + } + $cfile = $resurl; + } else { + return; + } + } else { + if ($resurl =~ m{^/?adm/viewclasslist$}) { + unless (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) { + return; + } + } elsif (!$crsedit) { +# +# No edit allowed where CC has switched to student role. +# + return; + } + } + } + + if ($file ne '') { + if (($cnum =~ /$match_courseid/) && ($cdom =~ /$match_domain/)) { + if (&is_course_upload($file,$cnum,$cdom)) { + $uploaded = 1; + $incourse = 1; + if ($file =~/\.(htm|html|css|js|txt)$/) { + $cfile = &hreflocation('',$file); + if ($env{'form.forceedit'}) { + $forceview = 1; + } else { + $forceedit = 1; + } + } + } elsif ($resurl =~ m{^/public/$cdom/$cnum/syllabus}) { + $incourse = 1; + if ($env{'form.forceedit'}) { + $forceview = 1; + } else { + $forceedit = 1; + } + $cfile = $resurl; + } elsif (($resurl ne '') && (&is_on_map($resurl))) { + if ($resurl =~ m{^/adm/$match_domain/$match_username/\d+/smppg|bulletinboard$}) { + $incourse = 1; + if ($env{'form.forceedit'}) { + $forceview = 1; + } else { + $forceedit = 1; + } + $cfile = $resurl; + } elsif ($resurl eq '/res/lib/templates/simpleproblem.problem') { + $incourse = 1; + $cfile = $resurl.'/smpedit'; + } elsif ($resurl =~ m{^/adm/wrapper/ext/}) { + $incourse = 1; + if ($env{'form.forceedit'}) { + $forceview = 1; + } else { + $forceedit = 1; + } + $cfile = $resurl; + } elsif ($resurl =~ m{^/?adm/viewclasslist$}) { + $incourse = 1; + if ($env{'form.forceedit'}) { + $forceview = 1; + } else { + $forceedit = 1; + } + $cfile = ($resurl =~ m{^/} ? $resurl : "/$resurl"); + } + } elsif ($resurl eq '/res/lib/templates/simpleproblem.problem/smpedit') { + my $template = '/res/lib/templates/simpleproblem.problem'; + if (&is_on_map($template)) { + $incourse = 1; + $forceview = 1; + $cfile = $template; + } + } elsif (($resurl =~ m{^/adm/wrapper/ext/}) && ($env{'form.folderpath'} =~ /^supplemental/)) { + $incourse = 1; + if ($env{'form.forceedit'}) { + $forceview = 1; + } else { + $forceedit = 1; + } + $cfile = $resurl; + } elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) { + $incourse = 1; + $forceview = 1; + if ($symb) { + my ($map,$id,$res)=&decode_symb($symb); + $env{'request.symb'} = $symb; + $cfile = &clutter($res); + } else { + $cfile = $env{'form.suppurl'}; + $cfile =~ s{^http://}{}; + $cfile = '/adm/wrapper/ext/'.$cfile; + } + } + } + if ($uploaded || $incourse) { + $home=&homeserver($cnum,$cdom); + } elsif ($file !~ m{/$}) { + $file=~s{^(priv/$match_domain/$match_username)}{/$1}; + $file=~s{^($match_domain/$match_username)}{/priv/$1}; + # Check that the user has permission to edit this resource + my $setpriv = 1; + my ($cfuname,$cfudom)=&constructaccess($file,$setpriv); + if (defined($cfudom)) { + $home=&homeserver($cfuname,$cfudom); + $cfile=$file; + } + } + if (($cfile ne '') && (!$incourse || $uploaded) && + (($home ne '') && ($home ne 'no_host'))) { + my @ids=¤t_machine_ids(); + unless (grep(/^\Q$home\E$/,@ids)) { + $switchserver=1; + } + } + } + return ($cfile,$home,$switchserver,$forceedit,$forceview); +} + +sub is_course_upload { + my ($file,$cnum,$cdom) = @_; + my $uploadpath = &LONCAPA::propath($cdom,$cnum); + $uploadpath =~ s{^\/}{}; + if (($file =~ m{^\Q$uploadpath\E/userfiles/(docs|supplemental)/}) || + ($file =~ m{^userfiles/\Q$cdom\E/\Q$cnum\E/(docs|supplemental)/})) { + return 1; + } + return; +} + +sub in_course { + my ($udom,$uname,$cdom,$cnum,$type,$hideprivileged) = @_; + if ($hideprivileged) { + my $skipuser; + if (&privileged($uname,$udom)) { + $skipuser = 1; + my %coursehash = &coursedescription($cdom.'_'.$cnum); + if ($coursehash{'nothideprivileged'}) { + foreach my $item (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) { + my $user; + if ($item =~ /:/) { + $user = $item; + } else { + $user = join(':',split(/[\@]/,$item)); + } + if ($user eq $uname.':'.$udom) { + undef($skipuser); + last; + } + } + } + if ($skipuser) { + return 0; + } + } + } + $type ||= 'any'; + if (!defined($cdom) || !defined($cnum)) { + my $cid = $env{'request.course.id'}; + $cdom = $env{'course.'.$cid.'.domain'}; + $cnum = $env{'course.'.$cid.'.num'}; + } + my $typesref; + if (($type eq 'any') || ($type eq 'all')) { + $typesref = ['active','previous','future']; + } elsif ($type eq 'previous' || $type eq 'future') { + $typesref = [$type]; + } + my %roles = &get_my_roles($uname,$udom,'userroles', + $typesref,undef,[$cdom]); + my ($tmp) = keys(%roles); + return 0 if ($tmp =~ /^(con_lost|error|no_such_host)/i); + my @course_roles = grep(/^\Q$cnum\E:\Q$cdom\E:/, keys(%roles)); + if (@course_roles > 0) { + return 1; + } + return 0; +} + # --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course # input: action, courseID, current domain, intended # path to file, source of file, instruction to parse file for objects, @@ -3032,6 +3312,7 @@ sub finishuserfileupload { sub extract_embedded_items { my ($fullpath,$allfiles,$codebase,$content) = @_; my @state = (); + my (%lastids,%related,%shockwave,%flashvars); my %javafiles = ( codebase => '', code => '', @@ -3061,10 +3342,30 @@ sub extract_embedded_items { &add_filetype($allfiles,$attr->{'href'},'href'); } if (lc($tagname) eq 'script') { + my $src; if ($attr->{'archive'} =~ /\.jar$/i) { &add_filetype($allfiles,$attr->{'archive'},'archive'); } else { - &add_filetype($allfiles,$attr->{'src'},'src'); + if ($attr->{'src'} ne '') { + $src = $attr->{'src'}; + &add_filetype($allfiles,$src,'src'); + } + } + my $text = $p->get_trimmed_text(); + if ($text =~ /\Qswfobject.registerObject(\E([^\)]+)\)/) { + my @swfargs = split(/,/,$1); + foreach my $item (@swfargs) { + $item =~ s/["']//g; + $item =~ s/^\s+//; + $item =~ s/\s+$//; + } + if (($swfargs[0] ne'') && ($swfargs[2] ne '')) { + if (ref($related{$swfargs[0]}) eq 'ARRAY') { + push(@{$related{$swfargs[0]}},$swfargs[2]); + } else { + $related{$swfargs[0]} = [$swfargs[2]]; + } + } } } if (lc($tagname) eq 'link') { @@ -3077,6 +3378,9 @@ sub extract_embedded_items { foreach my $item (keys(%javafiles)) { $javafiles{$item} = ''; } + if ((lc($tagname) eq 'object') && (lc($state[-2]) ne 'object')) { + $lastids{lc($tagname)} = $attr->{'id'}; + } } if (lc($state[-2]) eq 'object' && lc($tagname) eq 'param') { my $name = lc($attr->{'name'}); @@ -3086,12 +3390,22 @@ sub extract_embedded_items { last; } } + my $pathfrom; foreach my $item (keys(%mediafiles)) { if ($name eq $item) { - &add_filetype($allfiles, $attr->{'value'}, 'value'); + $pathfrom = $attr->{'value'}; + $shockwave{$lastids{lc($state[-2])}} = $pathfrom; + &add_filetype($allfiles,$pathfrom,$name); last; } } + if ($name eq 'flashvars') { + $flashvars{$lastids{lc($state[-2])}} = $attr->{'value'}; + } + if ($pathfrom ne '') { + &embedded_dependency($allfiles,\%related,$lastids{lc($state[-2])}, + $pathfrom); + } } if (lc($tagname) eq 'embed' || lc($tagname) eq 'applet') { foreach my $item (keys(%javafiles)) { @@ -3106,7 +3420,16 @@ sub extract_embedded_items { last; } } + if (lc($tagname) eq 'embed') { + if (($attr->{'name'} ne '') && ($attr->{'src'} ne '')) { + &embedded_dependency($allfiles,\%related,$attr->{'name'}, + $attr->{'src'}); + } + } } + if ($t->[4] =~ m{/>$}) { + pop(@state); + } } elsif ($t->[0] eq 'E') { my ($tagname) = ($t->[1]); if ($javafiles{'codebase'} ne '') { @@ -3126,6 +3449,23 @@ sub extract_embedded_items { pop @state; } } + foreach my $id (sort(keys(%flashvars))) { + if ($shockwave{$id} ne '') { + my @pairs = split(/\&/,$flashvars{$id}); + foreach my $pair (@pairs) { + my ($key,$value) = split(/\=/,$pair); + if ($key eq 'thumb') { + &add_filetype($allfiles,$value,$key); + } elsif ($key eq 'content') { + my ($path) = ($shockwave{$id} =~ m{^(.+/)[^/]+$}); + my ($ext) = ($value =~ /\.([^.]+)$/); + if ($ext ne '') { + &add_filetype($allfiles,$path.$value,$ext); + } + } + } + } + } return 'ok'; } @@ -3140,6 +3480,21 @@ sub add_filetype { } } +sub embedded_dependency { + my ($allfiles,$related,$identifier,$pathfrom) = @_; + if ((ref($allfiles) eq 'HASH') && (ref($related) eq 'HASH')) { + if (($identifier ne '') && + (ref($related->{$identifier}) eq 'ARRAY') && + ($pathfrom ne '')) { + my ($path) = ($pathfrom =~ m{^(.+/)[^/]+$}); + foreach my $dep (@{$related->{$identifier}}) { + &add_filetype($allfiles,$path.$dep,'object'); + } + } + } + return; +} + sub removeuploadedurl { my ($url)=@_; my (undef,undef,$udom,$uname,$fname)=split('/',$url,5); @@ -3269,6 +3624,7 @@ sub flushcourselogs { } } else { my ($dom,$name) = ($entry=~m{___($match_domain)/($match_name)/(.*)___(\w+)$}); + if (($dom eq 'uploaded') || ($dom eq 'adm')) { next; } my %temphash=($entry => $accesshash{$entry}); if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') { delete $accesshash{$entry}; @@ -3397,31 +3753,37 @@ sub linklog { $accesshash{$from.'___'.$to.'___comefrom'}=1; $accesshash{$to.'___'.$from.'___goto'}=1; } + +sub statslog { + my ($symb,$part,$users,$av_attempts,$degdiff)=@_; + if ($users<2) { return; } + my %dynstore=&LONCAPA::lonmetadata::dynamic_metadata_storage({ + 'course' => $env{'request.course.id'}, + 'sections' => '"all"', + 'num_students' => $users, + 'part' => $part, + 'symb' => $symb, + 'mean_tries' => $av_attempts, + 'deg_of_diff' => $degdiff}); + foreach my $key (keys(%dynstore)) { + $accesshash{$key}=$dynstore{$key}; + } +} sub userrolelog { my ($trole,$username,$domain,$area,$tstart,$tend)=@_; - if (($trole=~/^ca/) || ($trole=~/^aa/) || - ($trole=~/^in/) || ($trole=~/^cc/) || - ($trole=~/^ep/) || ($trole=~/^cr/) || - ($trole=~/^ta/) || ($trole=~/^co/)) { + if ( $trole =~ /^(ca|aa|in|cc|ep|cr|ta|co)/ ) { my (undef,$rudom,$runame,$rsec)=split(/\//,$area); $userrolehash {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} =$tend.':'.$tstart; } - if (($env{'request.role'} =~ /dc\./) && - (($trole=~/^au/) || ($trole=~/^in/) || - ($trole=~/^cc/) || ($trole=~/^ep/) || - ($trole=~/^cr/) || ($trole=~/^ta/) || - ($trole=~/^co/))) { + if ($env{'request.role'} =~ /dc\./ && $trole =~ /^(au|in|cc|ep|cr|ta|co)/) { $userrolehash {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'} =$tend.':'.$tstart; } - if (($trole=~/^dc/) || ($trole=~/^ad/) || - ($trole=~/^li/) || ($trole=~/^li/) || - ($trole=~/^au/) || ($trole=~/^dg/) || - ($trole=~/^sc/)) { + if ($trole =~ /^(dc|ad|li|au|dg|sc)/ ) { my (undef,$rudom,$runame,$rsec)=split(/\//,$area); $domainrolehash {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} @@ -3431,38 +3793,70 @@ sub userrolelog { sub courserolelog { my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$selfenroll,$context)=@_; - if (($trole eq 'cc') || ($trole eq 'in') || - ($trole eq 'ep') || ($trole eq 'ad') || - ($trole eq 'ta') || ($trole eq 'st') || - ($trole=~/^cr/) || ($trole eq 'gr') || - ($trole eq 'co')) { - if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) { - my $cdom = $1; - my $cnum = $2; - my $sec = $3; - my $namespace = 'rolelog'; - my %storehash = ( - role => $trole, - start => $tstart, - end => $tend, - selfenroll => $selfenroll, - context => $context, - ); - if ($trole eq 'gr') { - $namespace = 'groupslog'; - $storehash{'group'} = $sec; - } else { - $storehash{'section'} = $sec; - } - &instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom); - if (($trole ne 'st') || ($sec ne '')) { - &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum); - } + if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) { + my $cdom = $1; + my $cnum = $2; + my $sec = $3; + my $namespace = 'rolelog'; + my %storehash = ( + role => $trole, + start => $tstart, + end => $tend, + selfenroll => $selfenroll, + context => $context, + ); + if ($trole eq 'gr') { + $namespace = 'groupslog'; + $storehash{'group'} = $sec; + } else { + $storehash{'section'} = $sec; + } + &write_log('course',$namespace,\%storehash,$delflag,$username, + $domain,$cnum,$cdom); + if (($trole ne 'st') || ($sec ne '')) { + &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum); } } return; } +sub domainrolelog { + my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_; + if ($area =~ m{^/($match_domain)/$}) { + my $cdom = $1; + my $domconfiguser = &Apache::lonnet::get_domainconfiguser($cdom); + my $namespace = 'rolelog'; + my %storehash = ( + role => $trole, + start => $tstart, + end => $tend, + context => $context, + ); + &write_log('domain',$namespace,\%storehash,$delflag,$username, + $domain,$domconfiguser,$cdom); + } + return; + +} + +sub coauthorrolelog { + my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_; + if ($area =~ m{^/($match_domain)/($match_username)$}) { + my $audom = $1; + my $auname = $2; + my $namespace = 'rolelog'; + my %storehash = ( + role => $trole, + start => $tstart, + end => $tend, + context => $context, + ); + &write_log('author',$namespace,\%storehash,$delflag,$username, + $domain,$auname,$audom); + } + return; +} + sub get_course_adv_roles { my ($cid,$codes) = @_; $cid=$env{'request.course.id'} unless (defined($cid)); @@ -3530,8 +3924,7 @@ sub get_my_roles { unless (defined($udom)) { $udom=$env{'user.domain'}; } my (%dumphash,%nothide); if ($context eq 'userroles') { - my $extra = &freeze_escape({'skipcheck' => 1}); - %dumphash = &dump('roles',$udom,$uname,'.',undef,$extra); + %dumphash = &dump('roles',$udom,$uname); } else { %dumphash= &dump('nohist_userroles',$udom,$uname); @@ -3576,7 +3969,7 @@ sub get_my_roles { } my ($rolecode,$username,$domain,$section,$area); if ($context eq 'userroles') { - ($area,$rolecode) = split(/_/,$entry); + ($area,$rolecode) = ($entry =~ /^(.+)_([^_]+)$/); (undef,$domain,$username,$section) = split(/\//,$area); } else { ($role,$username,$domain,$section) = split(/\:/,$entry); @@ -3880,7 +4273,7 @@ my $cachedtime=(); sub load_all_first_access { my ($uname,$udom)=@_; if (($cachedkey eq $uname.':'.$udom) && - (abs($cachedtime-time)<5)) { + (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) { return; } $cachedtime=time; @@ -3889,10 +4282,11 @@ sub load_all_first_access { } sub get_first_access { - my ($type,$argsymb)=@_; + my ($type,$argsymb,$argmap)=@_; my ($symb,$courseid,$udom,$uname)=&whichuser(); if ($argsymb) { $symb=$argsymb; } my ($map,$id,$res)=&decode_symb($symb); + if ($argmap) { $map = $argmap; } if ($type eq 'course') { $res='course'; } elsif ($type eq 'map') { @@ -3905,7 +4299,7 @@ sub get_first_access { } sub set_first_access { - my ($type)=@_; + my ($type,$interval)=@_; my ($symb,$courseid,$udom,$uname)=&whichuser(); my ($map,$id,$res)=&decode_symb($symb); if ($type eq 'course') { @@ -3916,9 +4310,22 @@ sub set_first_access { $res=$symb; } $cachedkey=''; - my $firstaccess=&get_first_access($type,$symb); + my $firstaccess=&get_first_access($type,$symb,$map); if (!$firstaccess) { - return &put('firstaccesstimes',{"$courseid\0$res"=>time},$udom,$uname); + my $start = time; + my $putres = &put('firstaccesstimes',{"$courseid\0$res"=>$start}, + $udom,$uname); + if ($putres eq 'ok') { + &put('timerinterval',{"$courseid\0$res"=>$interval}, + $udom,$uname); + &appenv( + { + 'course.'.$courseid.'.firstaccess.'.$res => $start, + 'course.'.$courseid.'.timerinterval.'.$res => $interval, + } + ); + } + return $putres; } return 'already_set'; } @@ -4510,95 +4917,127 @@ sub update_released_required { sub privileged { my ($username,$domain)=@_; - my $rolesdump=&reply("dump:$domain:$username:roles", - &homeserver($username,$domain)); - if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || - ($rolesdump =~ /^error:/)) { - return 0; - } - my $now=time; - if ($rolesdump ne '') { - foreach my $entry (split(/&/,$rolesdump)) { - if ($entry!~/^rolesdef_/) { - my ($area,$role)=split(/=/,$entry); - $area=~s/\_\w\w$//; - my ($trole,$tend,$tstart)=split(/_/,$role); - if (($trole eq 'dc') || ($trole eq 'su')) { - my $active=1; - if ($tend) { - if ($tend<$now) { $active=0; } - } - if ($tstart) { - if ($tstart>$now) { $active=0; } - } - if ($active) { return 1; } - } - } + + my %rolesdump = &dump("roles", $domain, $username) or return 0; + my $now = time; + + for my $role (@rolesdump{grep { ! /^rolesdef_/ } keys %rolesdump}) { + my ($trole, $tend, $tstart) = split(/_/, $role); + if (($trole eq 'dc') || ($trole eq 'su')) { + return 1 unless ($tend && $tend < $now) + or ($tstart && $tstart > $now); + } } - } + return 0; } # -------------------------------------------------------- Get user privileges sub rolesinit { - my ($domain,$username,$authhost)=@_; - my $now=time; - my %userroles = ('user.login.time' => $now); - my $extra = &freeze_escape({'skipcheck' => 1}); - my $rolesdump=reply("dump:$domain:$username:roles:.::$extra",$authhost); - if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || - ($rolesdump =~ /^error:/)) { - return \%userroles; + my ($domain, $username) = @_; + my %userroles = ('user.login.time' => time); + my %rolesdump = &dump("roles", $domain, $username) or return \%userroles; + + # firstaccess and timerinterval are related to timed maps/resources. + # also, blocking can be triggered by an activating timer + # it's saved in the user's %env. + my %firstaccess = &dump('firstaccesstimes', $domain, $username); + my %timerinterval = &dump('timerinterval', $domain, $username); + my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals, + %timerintchk, %timerintenv); + + foreach my $key (keys(%firstaccess)) { + my ($cid, $rest) = split(/\0/, $key); + $coursetimerstarts{$cid}{$rest} = $firstaccess{$key}; + } + + foreach my $key (keys(%timerinterval)) { + my ($cid,$rest) = split(/\0/,$key); + $coursetimerintervals{$cid}{$rest} = $timerinterval{$key}; } + my %allroles=(); - my %allgroups=(); + my %allgroups=(); - if ($rolesdump ne '') { - foreach my $entry (split(/&/,$rolesdump)) { - if ($entry!~/^rolesdef_/) { - my ($area,$role)=split(/=/,$entry); - $area=~s/\_\w\w$//; - my ($trole,$tend,$tstart,$group_privs); - if ($role=~/^cr/) { - if ($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|) { - ($trole,my $trest)=($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|); - ($tend,$tstart)=split('_',$trest); - } else { - $trole=$role; - } - } elsif ($role =~ m|^gr/|) { - ($trole,$tend,$tstart) = split(/_/,$role); - next if ($tstart eq '-1'); - ($trole,$group_privs) = split(/\//,$trole); - $group_privs = &unescape($group_privs); - } else { - ($trole,$tend,$tstart)=split(/_/,$role); - } - my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain, - $username); - @userroles{keys(%new_role)} = @new_role{keys(%new_role)}; - if (($tend!=0) && ($tend<$now)) { $trole=''; } - if (($tstart!=0) && ($tstart>$now)) { $trole=''; } - if (($area ne '') && ($trole ne '')) { - my $spec=$trole.'.'.$area; - my ($tdummy,$tdomain,$trest)=split(/\//,$area); - if ($trole =~ /^cr\//) { - &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area); - } elsif ($trole eq 'gr') { - &group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart); - } else { - &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); - } + for my $area (grep { ! /^rolesdef_/ } keys %rolesdump) { + my $role = $rolesdump{$area}; + $area =~ s/\_\w\w$//; + + my ($trole, $tend, $tstart, $group_privs); + + if ($role =~ /^cr/) { + # Custom role, defined by a user + # e.g., user.role.cr/msu/smith/mynewrole + if ($role =~ m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|) { + $trole = $1; + ($tend, $tstart) = split('_', $2); + } else { + $trole = $role; } - } + } elsif ($role =~ m|^gr/|) { + # Role of member in a group, defined within a course/community + # e.g., user.role.gr/msu/04935610a19ee4a5fmsul1/leopards + ($trole, $tend, $tstart) = split(/_/, $role); + next if $tstart eq '-1'; + ($trole, $group_privs) = split(/\//, $trole); + $group_privs = &unescape($group_privs); + } else { + # Just a normal role, defined in roles.tab + ($trole, $tend, $tstart) = split(/_/,$role); + } + + my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain, + $username); + @userroles{keys(%new_role)} = @new_role{keys(%new_role)}; + + # role expired or not available yet? + $trole = '' if ($tend != 0 && $tend < $userroles{'user.login.time'}) or + ($tstart != 0 && $tstart > $userroles{'user.login.time'}); + + next if $area eq '' or $trole eq ''; + + my $spec = "$trole.$area"; + my ($tdummy, $tdomain, $trest) = split(/\//, $area); + + if ($trole =~ /^cr\//) { + # Custom role, defined by a user + &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area); + } elsif ($trole eq 'gr') { + # Role of a member in a group, defined within a course/community + &group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart); + next; + } else { + # Normal role, defined in roles.tab + &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); + } + + my $cid = $tdomain.'_'.$trest; + unless ($firstaccchk{$cid}) { + if (ref($coursetimerstarts{$cid}) eq 'HASH') { + foreach my $item (keys(%{$coursetimerstarts{$cid}})) { + $firstaccenv{'course.'.$cid.'.firstaccess.'.$item} = + $coursetimerstarts{$cid}{$item}; + } + } + $firstaccchk{$cid} = 1; + } + unless ($timerintchk{$cid}) { + if (ref($coursetimerintervals{$cid}) eq 'HASH') { + foreach my $item (keys(%{$coursetimerintervals{$cid}})) { + $timerintenv{'course.'.$cid.'.timerinterval.'.$item} = + $coursetimerintervals{$cid}{$item}; + } + } + $timerintchk{$cid} = 1; } - my ($author,$adv) = &set_userprivs(\%userroles,\%allroles,\%allgroups); - $userroles{'user.adv'} = $adv; - $userroles{'user.author'} = $author; - $env{'user.adv'}=$adv; } - return \%userroles; + + @userroles{'user.author', 'user.adv'} = &set_userprivs(\%userroles, + \%allroles, \%allgroups); + $env{'user.adv'} = $userroles{'user.adv'}; + + return (\%userroles,\%firstaccenv,\%timerintenv); } sub set_arearole { @@ -4852,15 +5291,19 @@ sub delete_env_groupprivs { sub check_adhoc_privs { my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_; my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; + my $setprivs; if ($env{$cckey}) { my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend); &role_status($cckey,$update,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend); unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) { &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller); + $setprivs = 1; } } else { &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller); + $setprivs = 1; } + return $setprivs; } sub set_adhoc_privileges { @@ -4933,16 +5376,17 @@ sub del { # -------------------------------------------------------------- dump interface sub dump { - my ($namespace,$udomain,$uname,$regexp,$range,$extra)=@_; + my ($namespace,$udomain,$uname,$regexp,$range)=@_; if (!$udomain) { $udomain=$env{'user.domain'}; } if (!$uname) { $uname=$env{'user.name'}; } my $uhome=&homeserver($uname,$udomain); + if ($regexp) { $regexp=&escape($regexp); } else { $regexp='.'; } - my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range:$extra",$uhome); + my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); my @pairs=split(/\&/,$rep); my %returnhash=(); if (!($rep =~ /^error/ )) { @@ -5246,6 +5690,88 @@ sub tmpdel { return &reply("tmpdel:$token",$server); } +# ------------------------------------------------------------ get_timebased_id + +sub get_timebased_id { + my ($prefix,$keyid,$namespace,$cdom,$cnum,$idtype,$who,$locktries, + $maxtries) = @_; + my ($newid,$error,$dellock); + unless (($prefix =~ /^\w+$/) && ($keyid =~ /^\w+$/) && ($namespace ne '')) { + return ('','ok','invalid call to get suffix'); + } + +# set defaults for any optional args for which values were not supplied + if ($who eq '') { + $who = $env{'user.name'}.':'.$env{'user.domain'}; + } + if (!$locktries) { + $locktries = 3; + } + if (!$maxtries) { + $maxtries = 10; + } + + if (($cdom eq '') || ($cnum eq '')) { + if ($env{'request.course.id'}) { + $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + } + if (($cdom eq '') || ($cnum eq '')) { + return ('','ok','call to get suffix not in course context'); + } + } + +# construct locking item + my $lockhash = { + $prefix."\0".'locked_'.$keyid => $who, + }; + my $tries = 0; + +# attempt to get lock on nohist_$namespace file + my $gotlock = &Apache::lonnet::newput('nohist_'.$namespace,$lockhash,$cdom,$cnum); + while (($gotlock ne 'ok') && $tries <$locktries) { + $tries ++; + sleep 1; + $gotlock = &Apache::lonnet::newput('nohist_'.$namespace,$lockhash,$cdom,$cnum); + } + +# attempt to get unique identifier, based on current timestamp + if ($gotlock eq 'ok') { + my %inuse = &Apache::lonnet::dump('nohist_'.$namespace,$cdom,$cnum,$prefix); + my $id = time; + $newid = $id; + my $idtries = 0; + while (exists($inuse{$prefix."\0".$newid}) && $idtries < $maxtries) { + if ($idtype eq 'concat') { + $newid = $id.$idtries; + } else { + $newid ++; + } + $idtries ++; + } + if (!exists($inuse{$prefix."\0".$newid})) { + my %new_item = ( + $prefix."\0".$newid => $who, + ); + my $putresult = &Apache::lonnet::put('nohist_'.$namespace,\%new_item, + $cdom,$cnum); + if ($putresult ne 'ok') { + undef($newid); + $error = 'error saving new item: '.$putresult; + } + } else { + $error = ('error: no unique suffix available for the new item '); + } +# remove lock + my @del_lock = ($prefix."\0".'locked_'.$keyid); + $dellock = &Apache::lonnet::del('nohist_'.$namespace,\@del_lock,$cdom,$cnum); + } else { + $error = "error: could not obtain lockfile\n"; + $dellock = 'ok'; + } + return ($newid,$dellock,$error); +} + # -------------------------------------------------- portfolio access checking sub portfolio_access { @@ -5501,10 +6027,15 @@ sub usertools_access { unofficial => 1, community => 1, ); + } elsif ($context eq 'requestauthor') { + %tools = ( + requestauthor => 1, + ); } else { %tools = ( aboutme => 1, blog => 1, + webdav => 1, portfolio => 1, ); } @@ -5519,25 +6050,32 @@ sub usertools_access { if ($action ne 'reload') { if ($context eq 'requestcourses') { return $env{'environment.canrequest.'.$tool}; + } elsif ($context eq 'requestauthor') { + return $env{'environment.canrequest.author'}; } else { return $env{'environment.availabletools.'.$tool}; } } } - my ($toolstatus,$inststatus); + my ($toolstatus,$inststatus,$envkey); + if ($context eq 'requestauthor') { + $envkey = $context; + } else { + $envkey = $context.'.'.$tool; + } if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) && ($action ne 'reload')) { - $toolstatus = $env{'environment.'.$context.'.'.$tool}; + $toolstatus = $env{'environment.'.$envkey}; $inststatus = $env{'environment.inststatus'}; } else { if (ref($userenvref) eq 'HASH') { - $toolstatus = $userenvref->{$context.'.'.$tool}; + $toolstatus = $userenvref->{$envkey}; $inststatus = $userenvref->{'inststatus'}; } else { - my %userenv = &userenvironment($udom,$uname,$context.'.'.$tool,'inststatus'); - $toolstatus = $userenv{$context.'.'.$tool}; + my %userenv = &userenvironment($udom,$uname,$envkey,'inststatus'); + $toolstatus = $userenv{$envkey}; $inststatus = $userenv{'inststatus'}; } } @@ -5603,7 +6141,7 @@ sub usertools_access { } } } else { - if ($context eq 'tools') { + if (($context eq 'tools') && ($tool ne 'webdav')) { $access = 1; } else { $access = 0; @@ -5979,7 +6517,12 @@ sub allowed { if ($match) { if ($env{'user.priv.'.$env{'request.role'}.'./'} =~/\Q$priv\E\&([^\:]*)/) { - $thisallowed.=$1; + my @blockers = &has_comm_blocking($priv,$symb,$uri); + if (@blockers > 0) { + $thisallowed = 'B'; + } else { + $thisallowed.=$1; + } } } else { my $refuri = $env{'httpref.'.$orguri} || $env{'httpref.'.$ver_orguri}; @@ -5990,7 +6533,12 @@ sub allowed { $refuri=&declutter($refuri); my ($match) = &is_on_map($refuri); if ($match) { - $thisallowed='F'; + my @blockers = &has_comm_blocking($priv,$symb,$refuri); + if (@blockers > 0) { + $thisallowed = 'B'; + } else { + $thisallowed='F'; + } } } } @@ -6042,7 +6590,17 @@ sub allowed { $statecond=$cond; if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid} =~/\Q$priv\E\&([^\:]*)/) { - $thisallowed.=$1; + my $value = $1; + if ($priv eq 'bre') { + my @blockers = &has_comm_blocking($priv,$symb,$uri); + if (@blockers > 0) { + $thisallowed = 'B'; + } else { + $thisallowed.=$value; + } + } else { + $thisallowed.=$value; + } $checkreferer=0; } } @@ -6070,7 +6628,17 @@ sub allowed { my $refstatecond=$cond; if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid} =~/\Q$priv\E\&([^\:]*)/) { - $thisallowed.=$1; + my $value = $1; + if ($priv eq 'bre') { + my @blockers = &has_comm_blocking($priv,$symb,$refuri); + if (@blockers > 0) { + $thisallowed = 'B'; + } else { + $thisallowed.=$value; + } + } else { + $thisallowed.=$value; + } $uri=$refuri; $statecond=$refstatecond; } @@ -6229,6 +6797,231 @@ sub allowed { } return 'F'; } + +# ------------------------------------------- Check construction space access + +sub constructaccess { + my ($url,$setpriv)=@_; + +# We do not allow editing of previous versions of files + if ($url=~/\.(\d+)\.(\w+)$/) { return ''; } + +# Get username and domain from URL + my ($ownername,$ownerdomain,$ownerhome); + + ($ownerdomain,$ownername) = + ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)/priv/($match_domain)/($match_username)/}); + +# The URL does not really point to any authorspace, forget it + unless (($ownername) && ($ownerdomain)) { return ''; } + +# Now we need to see if the user has access to the authorspace of +# $ownername at $ownerdomain + + if (($ownername eq $env{'user.name'}) && ($ownerdomain eq $env{'user.domain'})) { +# Real author for this? + $ownerhome = $env{'user.home'}; + if (exists($env{'user.priv.au./'.$ownerdomain.'/./'})) { + return ($ownername,$ownerdomain,$ownerhome); + } + } else { +# Co-author for this? + if (exists($env{'user.priv.ca./'.$ownerdomain.'/'.$ownername.'./'}) || + exists($env{'user.priv.aa./'.$ownerdomain.'/'.$ownername.'./'}) ) { + $ownerhome = &homeserver($ownername,$ownerdomain); + return ($ownername,$ownerdomain,$ownerhome); + } + } + +# We don't have any access right now. If we are not possibly going to do anything about this, +# we might as well leave + unless ($setpriv) { return ''; } + +# Backdoor access? + my $allowed=&allowed('eco',$ownerdomain); +# Nope + unless ($allowed) { return ''; } +# Looks like we may have access, but could be locked by the owner of the construction space + if ($allowed eq 'U') { + my %blocked=&get('environment',['domcoord.author'], + $ownerdomain,$ownername); +# Is blocked by owner + if ($blocked{'domcoord.author'} eq 'blocked') { return ''; } + } + if (($allowed eq 'F') || ($allowed eq 'U')) { +# Grant temporary access + my $then=$env{'user.login.time'}; + my $update==$env{'user.update.time'}; + if (!$update) { $update = $then; } + my $refresh=$env{'user.refresh.time'}; + if (!$refresh) { $refresh = $update; } + my $now = time; + &check_adhoc_privs($ownerdomain,$ownername,$update,$refresh, + $now,'ca','constructaccess'); + $ownerhome = &homeserver($ownername,$ownerdomain); + return($ownername,$ownerdomain,$ownerhome); + } +# No business here + return ''; +} + +sub get_comm_blocks { + my ($cdom,$cnum) = @_; + if ($cdom eq '' || $cnum eq '') { + return unless ($env{'request.course.id'}); + $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + } + my %commblocks; + my $hashid=$cdom.'_'.$cnum; + my ($blocksref,$cached)=&is_cached_new('comm_block',$hashid); + if ((defined($cached)) && (ref($blocksref) eq 'HASH')) { + %commblocks = %{$blocksref}; + } else { + %commblocks = &Apache::lonnet::dump('comm_block',$cdom,$cnum); + my $cachetime = 600; + &do_cache_new('comm_block',$hashid,\%commblocks,$cachetime); + } + return %commblocks; +} + +sub has_comm_blocking { + my ($priv,$symb,$uri,$blocks) = @_; + return unless ($env{'request.course.id'}); + return unless ($priv eq 'bre'); + return if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/); + my %commblocks; + if (ref($blocks) eq 'HASH') { + %commblocks = %{$blocks}; + } else { + %commblocks = &get_comm_blocks(); + } + return unless (keys(%commblocks) > 0); + if (!$symb) { $symb=&symbread($uri,1); } + my ($map,$resid,undef)=&decode_symb($symb); + my %tocheck = ( + maps => $map, + resources => $symb, + ); + my @blockers; + my $now = time; + my $navmap = Apache::lonnavmaps::navmap->new(); + foreach my $block (keys(%commblocks)) { + if ($block =~ /^(\d+)____(\d+)$/) { + my ($start,$end) = ($1,$2); + if ($start <= $now && $end >= $now) { + if (ref($commblocks{$block}{'blocks'}) eq 'HASH') { + if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') { + if (ref($commblocks{$block}{'blocks'}{'docs'}{'maps'}) eq 'HASH') { + if ($commblocks{$block}{'blocks'}{'docs'}{'maps'}{$map}) { + unless (grep(/^\Q$block\E$/,@blockers)) { + push(@blockers,$block); + } + } + } + if (ref($commblocks{$block}{'blocks'}{'docs'}{'resources'}) eq 'HASH') { + if ($commblocks{$block}{'blocks'}{'docs'}{'resources'}{$symb}) { + unless (grep(/^\Q$block\E$/,@blockers)) { + push(@blockers,$block); + } + } + } + } + } + } + } elsif ($block =~ /^firstaccess____(.+)$/) { + my $item = $1; + my @to_test; + if (ref($commblocks{$block}{'blocks'}) eq 'HASH') { + if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') { + my $check_interval; + if (&check_docs_block($commblocks{$block}{'blocks'}{'docs'},\%tocheck)) { + my @interval; + my $type = 'map'; + if ($item eq 'course') { + $type = 'course'; + @interval=&EXT("resource.0.interval"); + } else { + if ($item =~ /___\d+___/) { + $type = 'resource'; + @interval=&EXT("resource.0.interval",$item); + if (ref($navmap)) { + my $res = $navmap->getBySymb($item); + push(@to_test,$res); + } + } else { + my $mapsymb = &symbread($item,1); + if ($mapsymb) { + if (ref($navmap)) { + my $mapres = $navmap->getBySymb($mapsymb); + @to_test = $mapres->retrieveResources($mapres,undef,0,1); + foreach my $res (@to_test) { + my $symb = $res->symb(); + next if ($symb eq $mapsymb); + if ($symb ne '') { + @interval=&EXT("resource.0.interval",$symb); + last; + } + } + } + } + } + } + if ($interval[0] =~ /\d+/) { + my $first_access; + if ($type eq 'resource') { + $first_access=&get_first_access($interval[1],$item); + } elsif ($type eq 'map') { + $first_access=&get_first_access($interval[1],undef,$item); + } else { + $first_access=&get_first_access($interval[1]); + } + if ($first_access) { + my $timesup = $first_access+$interval[0]; + if ($timesup > $now) { + foreach my $res (@to_test) { + if ($res->is_problem()) { + if ($res->completable()) { + unless (grep(/^\Q$block\E$/,@blockers)) { + push(@blockers,$block); + } + last; + } + } + } + } + } + } + } + } + } + } + } + return @blockers; +} + +sub check_docs_block { + my ($docsblock,$tocheck) =@_; + if ((ref($docsblock) ne 'HASH') || (ref($tocheck) ne 'HASH')) { + return; + } + if (ref($docsblock->{'maps'}) eq 'HASH') { + if ($tocheck->{'maps'}) { + if ($docsblock->{'maps'}{$tocheck->{'maps'}}) { + return 1; + } + } + } + if (ref($docsblock->{'resources'}) eq 'HASH') { + if ($tocheck->{'resources'}) { + if ($docsblock->{'resources'}{$tocheck->{'resources'}}) { + return 1; + } + } + } + return; +} + # # Removes the versino from a URI and # splits it in to its filename and path to the filename. @@ -6964,8 +7757,7 @@ sub get_users_groups { } else { $grouplist = ''; my $courseurl = &courseid_to_courseurl($courseid); - my $extra = &freeze_escape({'skipcheck' => 1}); - my %roleshash = &dump('roles',$udom,$uname,$courseurl,undef,$extra); + my %roleshash = &dump('roles',$udom,$uname,$courseurl); my $access_end = $env{'course.'.$courseid. '.default_enrollment_end_date'}; my $now = time; @@ -7137,6 +7929,41 @@ sub assignrole { } } } + } elsif ($context eq 'requestauthor') { + if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) && + ($url eq '/'.$udom.'/') && ($role eq 'au')) { + if ($env{'environment.requestauthor'} eq 'automatic') { + $refused = ''; + } else { + my %domdefaults = &get_domain_defaults($udom); + if (ref($domdefaults{'requestauthor'}) eq 'HASH') { + my $checkbystatus; + if ($env{'user.adv'}) { + my $disposition = $domdefaults{'requestauthor'}{'_LC_adv'}; + if ($disposition eq 'automatic') { + $refused = ''; + } elsif ($disposition eq '') { + $checkbystatus = 1; + } + } else { + $checkbystatus = 1; + } + if ($checkbystatus) { + if ($env{'environment.inststatus'}) { + my @inststatuses = split(/,/,$env{'environment.inststatus'}); + foreach my $type (@inststatuses) { + if (($type ne '') && + ($domdefaults{'requestauthor'}{$type} eq 'automatic')) { + $refused = ''; + } + } + } elsif ($domdefaults{'requestauthor'}{'default'} eq 'automatic') { + $refused = ''; + } + } + } + } + } } if ($refused) { &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url. @@ -7186,11 +8013,25 @@ sub assignrole { # log new user role if status is ok if ($answer eq 'ok') { &userrolelog($role,$uname,$udom,$url,$start,$end); + if (($role eq 'cc') || ($role eq 'in') || + ($role eq 'ep') || ($role eq 'ad') || + ($role eq 'ta') || ($role eq 'st') || + ($role=~/^cr/) || ($role eq 'gr') || + ($role eq 'co')) { # for course roles, perform group memberships changes triggered by role change. - &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,$selfenroll,$context); - unless ($role =~ /^gr/) { - &Apache::longroup::group_changes($udom,$uname,$url,$role,$origend, - $origstart,$selfenroll,$context); + unless ($role =~ /^gr/) { + &Apache::longroup::group_changes($udom,$uname,$url,$role,$origend, + $origstart,$selfenroll,$context); + } + &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, + $selfenroll,$context); + } elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') || + ($role eq 'au') || ($role eq 'dc')) { + &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, + $context); + } elsif (($role eq 'ca') || ($role eq 'aa')) { + &coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, + $context); } if ($role eq 'cc') { &autoupdate_coowners($url,$end,$start,$uname,$udom); @@ -7778,13 +8619,16 @@ sub generate_coursenum { } sub is_course { - my ($cdom,$cnum) = @_; - my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef, - undef,'.'); - if (exists($courses{$cdom.'_'.$cnum})) { - return 1; - } - return 0; + my ($cdom, $cnum) = scalar(@_) == 1 ? + ($_[0] =~ /^($match_domain)_($match_courseid)$/) : @_; + + return unless $cdom and $cnum; + + my %courses = &courseiddump($cdom, '.', 1, '.', '.', $cnum, undef, undef, + '.'); + + return unless exists($courses{$cdom.'_'.$cnum}); + return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum; } sub store_userdata { @@ -9404,6 +10248,10 @@ sub gettitle { } $title=~s/\&colon\;/\:/gs; if ($title) { +# Remember both $symb and $title for dynamic metadata + $accesshash{$symb.'___crstitle'}=$title; + $accesshash{&declutter($map).'___'.&declutter($url).'___usage'}=time; +# Cache this title and then return it return &do_cache_new('title',$key,$title,600); } $urlsymb=$url; @@ -9413,6 +10261,78 @@ sub gettitle { return $title; } +sub getdocspath { + my ($symb) = @_; + my $path; + if ($symb) { + my ($mapurl,$id,$resurl) = &decode_symb($symb); + if ($resurl=~/\.(sequence|page)$/) { + $mapurl=$resurl; + } elsif ($resurl eq 'adm/navmaps') { + $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'}; + } + my $mapresobj; + my $navmap = Apache::lonnavmaps::navmap->new(); + if (ref($navmap)) { + $mapresobj = $navmap->getResourceByUrl($mapurl); + } + $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1}; + my $type=$2; + if (ref($mapresobj)) { + my $pcslist = $mapresobj->map_hierarchy(); + if ($pcslist ne '') { + foreach my $pc (split(/,/,$pcslist)) { + next if ($pc <= 1); + my $res = $navmap->getByMapPc($pc); + if (ref($res)) { + my $thisurl = $res->src(); + $thisurl=~s{^.*/([^/]+)\.\w+$}{$1}; + my $thistitle = $res->title(); + $path .= '&'. + &Apache::lonhtmlcommon::entity_encode($thisurl).'&'. + &Apache::lonhtmlcommon::entity_encode($thistitle). + ':'.$res->randompick(). + ':'.$res->randomout(). + ':'.$res->encrypted(). + ':'.$res->randomorder(). + ':'.$res->is_page(); + } + } + } + $path =~ s/^\&//; + my $maptitle = $mapresobj->title(); + if ($mapurl eq 'default') { + $maptitle = 'Main Course Documents'; + } + $path .= ($path ne '')? '&' : ''. + &Apache::lonhtmlcommon::entity_encode($mapurl).'&'. + &Apache::lonhtmlcommon::entity_encode($maptitle). + ':'.$mapresobj->randompick(). + ':'.$mapresobj->randomout(). + ':'.$mapresobj->encrypted(). + ':'.$mapresobj->randomorder(). + ':'.$mapresobj->is_page(); + } else { + my $maptitle = &gettitle($mapurl); + my $ispage; + if ($mapurl =~ /\.page$/) { + $ispage = 1; + } + if ($mapurl eq 'default') { + $maptitle = 'Main Course Documents'; + } + $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'. + &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage; + } + unless ($mapurl eq 'default') { + $path = 'default&'. + &Apache::lonhtmlcommon::entity_encode('Main Course Documents'). + ':::::&'.$path; + } + } + return $path; +} + sub get_slot { my ($which,$cnum,$cdom)=@_; if (!$cnum || !$cdom) { @@ -9479,6 +10399,41 @@ sub devalidate_slots_cache { &devalidate_cache_new('allslots',$hashid); } +sub get_coursechange { + my ($cdom,$cnum) = @_; + if ($cdom eq '' || $cnum eq '') { + return unless ($env{'request.course.id'}); + $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + } + my $hashid=$cdom.'_'.$cnum; + my ($change,$cached)=&is_cached_new('crschange',$hashid); + if ((defined($cached)) && ($change ne '')) { + return $change; + } else { + my %crshash; + %crshash = &get('environment',['internal.contentchange'],$cdom,$cnum); + if ($crshash{'internal.contentchange'} eq '') { + $change = $env{'course.'.$cdom.'_'.$cnum.'.internal.created'}; + if ($change eq '') { + %crshash = &get('environment',['internal.created'],$cdom,$cnum); + $change = $crshash{'internal.created'}; + } + } else { + $change = $crshash{'internal.contentchange'}; + } + my $cachetime = 600; + &do_cache_new('crschange',$hashid,$change,$cachetime); + } + return $change; +} + +sub devalidate_coursechange_cache { + my ($cnum,$cdom)=@_; + my $hashid=$cnum.':'.$cdom; + &devalidate_cache_new('crschange',$hashid); +} + # ------------------------------------------------- Update symbolic store links sub symblist { @@ -9506,7 +10461,7 @@ sub symblist { # --------------------------------------------------------------- Verify a symb sub symbverify { - my ($symb,$thisurl)=@_; + my ($symb,$thisurl,$encstate)=@_; my $thisfn=$thisurl; $thisfn=&declutter($thisfn); # direct jump to resource in page or to a sequence - will construct own symbs @@ -9525,31 +10480,46 @@ sub symbverify { if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db', &GDBM_READER(),0640)) { + my $noclutter; if (($thisurl =~ m{^/adm/wrapper/ext/}) || ($thisurl =~ m{^ext/})) { $thisurl =~ s/\?.+$//; + if ($map =~ m{^uploaded/.+\.page$}) { + $thisurl =~ s{^(/adm/wrapper|)/ext/}{http://}; + $thisurl =~ s{^\Qhttp://https://\E}{https://}; + $noclutter = 1; + } + } + my $ids; + if ($noclutter) { + $ids=$bighash{'ids_'.$thisurl}; + } else { + $ids=$bighash{'ids_'.&clutter($thisurl)}; } - my $ids=$bighash{'ids_'.&clutter($thisurl)}; unless ($ids) { - my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl; + my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl; $ids=$bighash{$idkey}; } if ($ids) { # ------------------------------------------------------------------- Has ID(s) + if ($thisfn =~ m{^/adm/wrapper/ext/}) { + $symb =~ s/\?.+$//; + } foreach my $id (split(/\,/,$ids)) { my ($mapid,$resid)=split(/\./,$id); - if ($thisfn =~ m{^/adm/wrapper/ext/}) { - $symb =~ s/\?.+$//; - } if ( &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) - eq $symb) { - if (($env{'request.role.adv'}) || - ($bighash{'encrypted_'.$id} eq $env{'request.enc'}) || + eq $symb) { + if (ref($encstate)) { + $$encstate = $bighash{'encrypted_'.$id}; + } + if (($env{'request.role.adv'}) || + ($bighash{'encrypted_'.$id} eq $env{'request.enc'}) || ($thisurl eq '/adm/navmaps')) { - $okay=1; - } - } - } + $okay=1; + last; + } + } + } } untie(%bighash); } @@ -9622,14 +10592,18 @@ sub deversion { sub symbread { my ($thisfn,$donotrecurse)=@_; - my $cache_str='request.symbread.cached.'.$thisfn; - if (defined($env{$cache_str})) { return $env{$cache_str}; } + my $cache_str; + if ($thisfn ne '') { + $cache_str='request.symbread.cached.'.$thisfn; + if ($env{$cache_str} ne '') { + return $env{$cache_str}; + } + } else { # no filename provided? try from environment - unless ($thisfn) { if ($env{'request.symb'}) { - return $env{$cache_str}=&symbclean($env{'request.symb'}); - } - $thisfn=$env{'request.filename'}; + return $env{$cache_str}=&symbclean($env{'request.symb'}); + } + $thisfn=$env{'request.filename'}; } if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); } # is that filename actually a symb? Verify, clean, and return @@ -9857,7 +10831,6 @@ sub rndseed { $which =&get_rand_alg($courseid); } if (defined(&getCODE())) { - if ($which eq '64bit5') { return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username); } elsif ($which eq '64bit4') { @@ -10183,7 +11156,7 @@ sub repcopy_userfile { my ($file)=@_; my $londocroot = $perlvar{'lonDocRoot'}; if ($file =~ m{^/*(uploaded|editupload)/}) { $file=&filelocation("",$file); } - if ($file =~ m{^\Q$londocroot/lonUsers/\E}) { return 'ok'; } + if ($file =~ m{^\Q/home/httpd/lonUsers/\E}) { return 'ok'; } my ($cdom,$cnum,$filename) = ($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_name)/+(.*)|); my $uri="/uploaded/$cdom/$cnum/$filename"; @@ -10440,6 +11413,7 @@ sub declutter { $thisfn=~s|^adm/wrapper/||; $thisfn=~s|^adm/coursedocs/showdoc/||; $thisfn=~s/^res\///; + $thisfn=~s/^priv\///; unless (($thisfn =~ /^ext/) || ($thisfn =~ /\.(page|sequence)___\d+___ext/)) { $thisfn=~s/\?.+$//; } @@ -11358,7 +12332,13 @@ B: store away a list =item * X -B: get user privileges +B: get user privileges. +returns user role, first access and timer interval hashes + +=item * +X +B: returns a true if user has a +privileged and active role (i.e. su or dc), false otherwise. =item * X @@ -11399,6 +12379,21 @@ allowed($priv,$uri,$symb,$role) : check =item * +constructaccess($url,$setpriv) : check for access to construction space URL + +See if the owner domain and name in the URL match those in the +expected environment. If so, return three element list +($ownername,$ownerdomain,$ownerhome). + +Otherwise return the null string. + +If second argument 'setpriv' is true, it assigns the privileges, +and returns the same three element list, unless the owner has +blocked "ad hoc" Domain Coordinator access to the Author Space, +in which case the null string is returned. + +=item * + definerole($rolename,$sysrole,$domrole,$courole) : define role; define a custom role rolename set privileges in format of lonTabs/roles.tab for system, domain, and course level @@ -11429,6 +12424,17 @@ of role statuses (active, future or prev to restrict the list of roles reported. If no array ref is provided for types, will default to return only active roles. +=item * + +in_course($udom,$uname,$cdom,$cnum,$type,$hideprivileged) : determine if +user: $uname:$udom has a role in the course: $cdom_$cnum. + +Additional optional arguments are: $type (if role checking is to be restricted +to certain user status types -- previous (expired roles), active (currently +available roles) or future (roles available in the future), and +$hideprivileged -- if true will not report course roles for users who +have active Domain Coordinator or Super User roles. + =back =head2 User Modification @@ -11631,7 +12637,6 @@ data base, returning a hash that is keye values that are the resource value. I believe that the timestamps and versions are also returned. - =back =head2 Course Modification @@ -11651,6 +12656,19 @@ createcourse($udom,$description,$url,$co generate_coursenum($udom,$crstype) : get a unique (unused) course number in domain $udom for course type $crstype (Course or Community). +=item * + +is_course($courseid), is_course($cdom, $cnum) + +Accepts either a combined $courseid (in the form of domain_courseid) or the +two component version $cdom, $cnum. It checks if the specified course exists. + +Returns: + undef if the course doesn't exist, otherwise + in scalar context the combined courseid. + in list context the two components of the course identifier, domain and + courseid. + =back =head2 Resource Subroutines @@ -11719,12 +12737,14 @@ returns the data handle =item * -symbverify($symb,$thisfn) : verifies that $symb actually exists and is -a possible symb for the URL in $thisfn, and if is an encryypted +symbverify($symb,$thisfn,$ecstate) : verifies that $symb actually exists +and is a possible symb for the URL in $thisfn, and if is an encrypted 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'} - +on failure, user must be in a course, as it assumes the existence of +the course initial hash, and uses $env('request.course.id'}. The third +arg is an optional reference to a scalar. If this arg is passed in the +call to symbverify, it will be set to 1 if the symb has been set to be +encrypted; otherwise it will be null. =item * @@ -11777,6 +12797,34 @@ expirespread($uname,$udom,$stype,$usymb) devalidate($symb) : devalidate temporary spreadsheet calculations, forcing spreadsheet to reevaluate the resource scores next time. +=item * + +can_edit_resource($file,$cnum,$cdom,$resurl,$symb,$group) : determine if current user can edit a particular resource, +when viewing in course context. + + input: six args -- filename (decluttered), course number, course domain, + url, symb (if registered) and group (if this is a + group item -- e.g., bulletin board, group page etc.). + + output: array of five scalars -- + $cfile -- url for file editing if editable on current server + $home -- homeserver of resource (i.e., for author if published, + or course if uploaded.). + $switchserver -- 1 if server switch will be needed. + $forceedit -- 1 if icon/link should be to go to edit mode + $forceview -- 1 if icon/link should be to go to view mode + +=item * + +is_course_upload($file,$cnum,$cdom) + +Used in course context to determine if current file was uploaded to +the course (i.e., would be found in /userfiles/docs on the course's +homeserver. + + input: 3 args -- filename (decluttered), course number and course domain. + output: boolean -- 1 if file was uploaded. + =back =head2 Storing/Retreiving Data @@ -12332,6 +13380,8 @@ Internal notes: Locks on files (resulting from submission of portfolio file to a homework problem stored in array of arrays. +=item * + modify_access_controls(): Modifies access controls for a portfolio file @@ -12349,7 +13399,51 @@ Returns: 3. reference to hash of any new or updated access controls. 4. reference to hash used to map incoming IDs to uniqueIDs assigned to control. key = integer (inbound ID) - value = uniqueID + value = uniqueID + +=item * + +get_timebased_id(): + +Attempts to get a unique timestamp-based suffix for use with items added to a +course via the Course Editor (e.g., folders, composite pages, +group bulletin boards). + +Args: (first three required; six others optional) + +1. prefix (alphanumeric): of keys in hash, e.g., suppsequence, docspage, + docssequence, or name of group + +2. keyid (alphanumeric): name of temporary locking key in hash, + e.g., num, boardids + +3. namespace: name of gdbm file used to store suffixes already assigned; + file will be named nohist_namespace.db + +4. cdom: domain of course; default is current course domain from %env + +5. cnum: course number; default is current course number from %env + +6. idtype: set to concat if an additional digit is to be appended to the + unix timestamp to form the suffix, if the plain timestamp is already + in use. Default is to not do this, but simply increment the unix + timestamp by 1 until a unique key is obtained. + +7. who: holder of locking key; defaults to user:domain for user. + +8. locktries: number of attempts to obtain a lock (sleep of 1s before + retrying); default is 3. + +9. maxtries: number of attempts to obtain a unique suffix; default is 20. + +Returns: + +1. suffix obtained (numeric) + +2. result of deleting locking key (ok if deleted, or lock never obtained) + +3. error: contains (localized) error message if an error occurred. + =back