--- loncom/lonnet/perl/lonnet.pm 2006/06/07 18:41:57 1.745 +++ loncom/lonnet/perl/lonnet.pm 2006/07/21 08:40:54 1.764.2.1 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.745 2006/06/07 18:41:57 raeburn Exp $ +# $Id: lonnet.pm,v 1.764.2.1 2006/07/21 08:40:54 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -281,6 +281,17 @@ sub critical { return $answer; } +# ------------------------------------------- check if return value is an error + +sub error { + my ($result) = @_; + if ($result =~ /^(con_lost|no_such_host|error: (\d+) (.*))/) { + if ($2 == 2) { return undef; } + return $1; + } + return undef; +} + # ------------------------------------------- Transfer profile into environment sub transfer_profile_to_env { @@ -1874,9 +1885,6 @@ sub get_course_adv_roles { (!$nothide{$username.':'.$domain})) { next; } if ($role eq 'cr') { next; } my $key=&plaintext($role); - if ($role =~ /^cr/) { - $key=(split('/',$role))[3]; - } if ($section) { $key.=' (Sec/Grp '.$section.')'; } if ($returnhash{$key}) { $returnhash{$key}.=','.$username.':'.$domain; @@ -2922,23 +2930,25 @@ sub del { # -------------------------------------------------------------- dump interface sub dump { - 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",$uhome); - my @pairs=split(/\&/,$rep); - my %returnhash=(); - foreach (@pairs) { - my ($key,$value)=split(/=/,$_,2); - $returnhash{unescape($key)}=&thaw_unescape($value); - } - return %returnhash; + 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",$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); + } + return %returnhash; } # --------------------------------------------------------- dumpstore interface @@ -3264,7 +3274,7 @@ sub allowed { return 'F'; } -# bre access to group if user has rgf priv for this group and course. +# bre access to group portfolio for rgf priv in group, or mdg or vcg in course. if (($space=~/^(uploaded|editupload)$/) && ($dir[0] eq 'groups') && ($dir[2] eq 'portfolio') && ($priv eq 'bre')) { if (exists($env{'request.course.id'})) { @@ -3276,6 +3286,14 @@ sub allowed { if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid .'/'.$dir[1]} =~/rgf\&([^\:]*)/) { return $1; + } else { + if ($env{'request.course.sec'}) { + $courseprivid.='/'.$env{'request.course.sec'}; + } + if ($env{'user.priv.'.$env{'request.role'}.'./'. + $courseprivid} =~/(mdg|vcg)\&([^\:]*)/) { + return $2; + } } } } @@ -3344,14 +3362,6 @@ sub allowed { $thisallowed.=$1; } -# Group: uri itself is a group - my $groupuri=$uri; - $groupuri=~s/^([^\/])/\/$1/; - if ($env{'user.priv.'.$env{'request.role'}.'.'.$groupuri} - =~/\Q$priv\E\&([^\:]*)/) { - $thisallowed.=$1; - } - # URI is an uploaded document for this course, default permissions don't matter # not allowing 'edit' access (editupload) to uploaded course docs if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) { @@ -4100,6 +4110,9 @@ sub devalidate_getgroups_cache { sub plaintext { my ($short,$type,$cid) = @_; + if ($short =~ /^cr/) { + return (split('/',$short))[-1]; + } if (!defined($cid)) { $cid = $env{'request.course.id'}; } @@ -4555,18 +4568,13 @@ sub is_locked { $env{'user.domain'},$env{'user.name'}); my ($tmp)=keys(%locked); if ($tmp=~/^error:/) { undef(%locked); } - if (ref($locked{$file_name}) eq 'ARRAY') { $is_locked = 'false'; foreach my $entry (@{$locked{$file_name}}) { if (ref($entry) eq 'ARRAY') { - if ($$entry[0] eq 'access' || $$entry[0] eq 'accesscount') { - next; - } else { - $is_locked = 'true'; - last; - } + $is_locked = 'true'; + last; } } } else { @@ -4574,6 +4582,14 @@ sub is_locked { } } +sub declutter_portfile { + my ($file) = @_; + &logthis("got $file"); + $file =~ s-^(/portfolio/|portfolio/)-/-; + &logthis("ret $file"); + return $file; +} + # ------------------------------------------------------------- Mark as Read Only sub mark_as_readonly { @@ -4582,6 +4598,7 @@ sub mark_as_readonly { my ($tmp)=keys(%current_permissions); if ($tmp=~/^error:/) { undef(%current_permissions); } foreach my $file (@{$files}) { + $file = &declutter_portfile($file); push(@{$current_permissions{$file}},$what); } &put('file_permissions',\%current_permissions,$domain,$user); @@ -4669,38 +4686,121 @@ sub get_portfile_permissions { #---------------------------------------------Get portfolio file access controls -sub get_access_controls { +sub get_access_controls { my ($current_permissions,$group,$file) = @_; - my @access_checks = (); my %access; if (defined($file)) { - @access_checks = ($file); + if (ref($$current_permissions{$file."\0".'accesscontrol'}) eq 'HASH') { + foreach my $control (keys(%{$$current_permissions{$file."\0".'accesscontrol'}})) { + $access{$file}{$control} = $$current_permissions{$file."\0".$control}; + } + } } else { - @access_checks = keys(%{$current_permissions}); + foreach my $key (keys(%{$current_permissions})) { + if ($key =~ /\0accesscontrol$/) { + if (defined($group)) { + if ($key !~ m-^\Q$group\E/-) { + next; + } + } + my ($fullpath) = split(/\0/,$key); + if (ref($$current_permissions{$key}) eq 'HASH') { + foreach my $control (keys(%{$$current_permissions{$key}})) { + $access{$fullpath}{$control}=$$current_permissions{$fullpath."\0".$control}; + } + } + } + } } - foreach my $file_name (@access_checks) { - my $value = $$current_permissions{$file_name}; - if (defined($group)) { - if ($file_name !~ m-^\Q$group\E/-) { - next; + return %access; +} + +sub modify_access_controls { + my ($file_name,$changes,$domain,$user)=@_; + my ($outcome,$deloutcome); + my %store_permissions; + my %new_values; + my %new_control; + my %translation; + my @deletions = (); + my $now = time; + if (exists($$changes{'activate'})) { + if (ref($$changes{'activate'}) eq 'HASH') { + my @newitems = sort(keys(%{$$changes{'activate'}})); + my $numnew = scalar(@newitems); + for (my $i=0; $i<$numnew; $i++) { + my $newkey = $newitems[$i]; + my $newid = &Apache::loncommon::get_cgi_id(); + $newkey =~ s/^(\d+)/$newid/; + $translation{$1} = $newid; + $new_values{$file_name."\0".$newkey} = + $$changes{'activate'}{$newitems[$i]}; + $new_control{$newkey} = $now; } } - if (ref($value) eq "ARRAY") { - foreach my $stored_what (@{$value}) { - if (ref($stored_what) eq 'ARRAY') { - if ($$stored_what[0] eq 'access') { - if (!defined($access{$file_name})) { - %{$access{$file_name}} = (); - } - $access{$file_name}{$$stored_what[1]}=$$stored_what[2]; + } + my %todelete; + my %changed_items; + foreach my $action ('delete','update') { + if (exists($$changes{$action})) { + if (ref($$changes{$action}) eq 'HASH') { + foreach my $key (keys(%{$$changes{$action}})) { + my ($itemnum) = ($key =~ /^([^:]+):/); + if ($action eq 'delete') { + $todelete{$itemnum} = 1; } else { - next; + $changed_items{$itemnum} = $key; } } } } } - return %access; + # get lock on access controls for file. + my $lockhash = { + $file_name."\0".'locked_access_records' => $env{'user.name'}. + ':'.$env{'user.domain'}, + }; + my $tries = 0; + my $gotlock = &newput('file_permissions',$lockhash,$domain,$user); + + while (($gotlock ne 'ok') && $tries <3) { + $tries ++; + sleep 1; + $gotlock = &newput('file_permissions',$lockhash,$domain,$user); + } + if ($gotlock eq 'ok') { + my %curr_permissions = &dump('file_permissions',$domain,$user,$file_name); + my ($tmp)=keys(%curr_permissions); + if ($tmp=~/^error:/) { undef(%curr_permissions); } + if (exists($curr_permissions{$file_name."\0".'accesscontrol'})) { + my $curr_controls = $curr_permissions{$file_name."\0".'accesscontrol'}; + if (ref($curr_controls) eq 'HASH') { + foreach my $control_item (keys(%{$curr_controls})) { + my ($itemnum) = ($control_item =~ /^([^:]+):/); + if (defined($todelete{$itemnum})) { + push(@deletions,$file_name."\0".$control_item); + } else { + if (defined($changed_items{$itemnum})) { + $new_control{$changed_items{$itemnum}} = $now; + push(@deletions,$file_name."\0".$control_item); + $new_values{$file_name."\0".$changed_items{$itemnum}} = $$changes{'update'}{$changed_items{$itemnum}}; + } else { + $new_control{$control_item} = $$curr_controls{$control_item}; + } + } + } + } + } + $deloutcome = &del('file_permissions',\@deletions,$domain,$user); + $new_values{$file_name."\0".'accesscontrol'} = \%new_control; + $outcome = &put('file_permissions',\%new_values,$domain,$user); + # remove lock + my @del_lock = ($file_name."\0".'locked_access_records'); + my $dellockoutcome = &del('file_permissions',\@del_lock,$domain,$user); + } else { + $outcome = "error: could not obtain lockfile\n"; + } + return ($outcome,$deloutcome,\%new_values,\%translation); } #------------------------------------------------------Get Marked as Read Only @@ -4720,13 +4820,8 @@ sub get_marked_as_readonly { if (ref($value) eq "ARRAY"){ foreach my $stored_what (@{$value}) { my $cmp2=$stored_what; - if (ref($stored_what)) { - if ($$stored_what[0] eq 'access' || - $$stored_what[0] eq 'accesscount') { - next; - } else { - $cmp2=join('',@{$stored_what}); - } + if (ref($stored_what) eq 'ARRAY') { + $cmp2=join('',@{$stored_what}); } if ($cmp1 eq $cmp2) { push(@readonly_files, $file_name); @@ -4754,16 +4849,18 @@ sub get_marked_as_readonly_hash { if (ref($value) eq "ARRAY"){ foreach my $stored_what (@{$value}) { if (ref($stored_what) eq 'ARRAY') { - if ($$stored_what[0] eq 'access' || - $$stored_what[0] eq 'accesscount') { - next; + foreach my $lock_descriptor(@{$stored_what}) { + if ($lock_descriptor eq 'graded') { + $readonly_files{$file_name} = 'graded'; + } elsif ($lock_descriptor eq 'handback') { + $readonly_files{$file_name} = 'handback'; + } else { + if (!exists($readonly_files{$file_name})) { + $readonly_files{$file_name} = 'locked'; + } + } } - } - if ($stored_what eq $what) { - $readonly_files{$file_name} = 'locked'; - } elsif (!defined($what)) { - $readonly_files{$file_name} = 'locked'; - } + } } } } @@ -4775,6 +4872,7 @@ sub unmark_as_readonly { # unmarks $file_name (if $file_name is defined), or all files locked by $what # for portfolio submissions, $what contains [$symb,$crsid] my ($domain,$user,$what,$file_name,$group) = @_; + $file_name = &declutter_portfile($file_name); my $symb_crs = $what; if (ref($what)) { $symb_crs=join('',@$what); } my %current_permissions = &dump('file_permissions',$domain,$user,$group); @@ -4782,7 +4880,8 @@ sub unmark_as_readonly { if ($tmp=~/^error:/) { undef(%current_permissions); } my @readonly_files = &get_marked_as_readonly($domain,$user,$what,$group); foreach my $file (@readonly_files) { - if (defined($file_name) && ($file_name ne $file)) { next; } + my $clean_file = &declutter_portfile($file); + if (defined($file_name) && ($file_name ne $clean_file)) { next; } my $current_locks = $current_permissions{$file}; my @new_locks; my @del_keys; @@ -4790,15 +4889,10 @@ sub unmark_as_readonly { foreach my $locker (@{$current_locks}) { my $compare=$locker; if (ref($locker) eq 'ARRAY') { - if ($$locker[0] eq 'access' || - $$locker[0] eq 'accesscount') { - push(@new_locks,$locker); - next; - } $compare=join('',@{$locker}); - } - if ($compare ne $symb_crs) { - push(@new_locks, $locker); + if ($compare ne $symb_crs) { + push(@new_locks, $locker); + } } } if (scalar(@new_locks) > 0) { @@ -5061,6 +5155,7 @@ sub devalidatecourseresdata { &devalidate_cache_new('courseres',$hashid); } + # --------------------------------------------------- Course Resourcedata Query sub get_courseresdata { @@ -5782,6 +5877,17 @@ sub metadata_generate_part0 { } } +# ------------------------------------------------------ Devalidate title cache + +sub devalidate_title_cache { + my ($url)=@_; + if (!$env{'request.course.id'}) { return; } + my $symb=&symbread($url); + if (!$symb) { return; } + my $key=$env{'request.course.id'}."\0".$symb; + &devalidate_cache_new('title',$key); +} + # ------------------------------------------------- Get the title of a resource sub gettitle { @@ -6828,7 +6934,7 @@ BEGIN { } close($config); # FIXME: dev server don't want this, production servers _do_ want this - #&get_iphost(); + &get_iphost(); } sub get_iphost { @@ -7587,6 +7693,31 @@ cput($namespace,$storehash,$udom,$uname) =item * +newput($namespace,$storehash,$udom,$uname) : + +Attempts to store the items in the $storehash, but only if they don't +currently exist, if this succeeds you can be certain that you have +successfully created a new key value pair in the $namespace db. + + +Args: + $namespace: name of database to store values to + $storehash: hashref to store to the db + $udom: (optional) domain of user containing the db + $uname: (optional) name of user caontaining the db + +Returns: + 'ok' -> succeeded in storing all keys of $storehash + 'key_exists: ' -> failed to anything out of $storehash, as at + least already existed in the db (other + requested keys may also already exist) + 'error: ' -> unable to tie the DB or other erorr occured + 'con_lost' -> unable to contact request server + 'refused' -> action was not allowed by remote machine + + +=item * + eget($namespace,$storearr,$udom,$uname) : returns hash with keys from array reference filled in from namesp (encrypts the return communication) ($udom and $uname are optional) @@ -7821,6 +7952,103 @@ removeuploadedurl(): convience function Args: url: a full /uploaded/... url to delete +=item * + +get_portfile_permissions(): + Args: + domain: domain of user or course contain the portfolio files + user: name of user or num of course contain the portfolio files + Returns: + hashref of a dump of the proper file_permissions.db + + +=item * + +get_access_controls(): + +Args: + current_permissions: the hash ref returned from get_portfile_permissions() + group: (optional) the group you want the files associated with + file: (optional) the file you want access info on + +Returns: + a hash (keys are file names) of hashes containing + keys are: path to file/file_name\0uniqueID:scope_end_start (see below) + values are XML containing access control settings (see below) + +Internal notes: + + access controls are stored in file_permissions.db as key=value pairs. + key -> path to file/file_name\0uniqueID:scope_end_start + where scope -> public,guest,course,group,domains or users. + end -> UNIX time for end of access (0 -> no end date) + start -> UNIX time for start of access + + value -> XML description of access control + (type =1 of: public,guest,course,group,domains,users"> + + + + for scope type = guest + + for scope type = course or group + + + + +
+ + + + for scope type = domains + + for scope type = users + + + + + + + + Access data is also aggregated for each file in an additional key=value pair: + key -> path to file/file_name\0accesscontrol + value -> reference to hash + hash contains key = value pairs + where key = uniqueID:scope_end_start + value = UNIX time record was last updated + + Used to improve speed of look-ups of access controls for each file. + + Locks on files (resulting from submission of portfolio file to a homework problem stored in array of arrays. + +parse_access_controls(): + +Parses XML of an access control record +Args +1. Text string (XML) of access comtrol record + +Returns: +1. Hash of access control settings. + +modify_access_controls(): + +Modifies access controls for a portfolio file +Args +1. file name +2. reference to hash of required changes, +3. domain +4. username + where domain,username are the domain of the portfolio owner + (either a user or a course) + +Returns: +1. result of additions or updates ('ok' or 'error', with error message). +2. result of deletions ('ok' or 'error', with error message). +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 + =back =head2 HTTP Helper Routines