--- loncom/lonnet/perl/lonnet.pm 2006/06/05 20:09:19 1.744 +++ loncom/lonnet/perl/lonnet.pm 2006/06/22 13:16:09 1.753 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.744 2006/06/05 20:09:19 albertel Exp $ +# $Id: lonnet.pm,v 1.753 2006/06/22 13:16:09 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4555,9 +4555,15 @@ 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 = 'true'; + $is_locked = 'false'; + foreach my $entry (@{$locked{$file_name}}) { + if (ref($entry) eq 'ARRAY') { + $is_locked = 'true'; + last; + } + } } else { $is_locked = 'false'; } @@ -4646,49 +4652,254 @@ sub files_not_in_path { return (@return_files); } -#--------------------------------------------------------------Get Marked as Read Only - +#----------------------------------------------Get portfolio file permissions -sub get_marked_as_readonly { - my ($domain,$user,$what) = @_; +sub get_portfile_permissions { + my ($domain,$user) = @_; my %current_permissions = &dump('file_permissions',$domain,$user); my ($tmp)=keys(%current_permissions); if ($tmp=~/^error:/) { undef(%current_permissions); } + return \%current_permissions; +} + +#---------------------------------------------Get portfolio file access controls + +sub get_access_controls { + my ($current_permissions,$group,$file) = @_; + my %access; + if (defined($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 { + 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}; + } + } + } + } + } + return %access; +} + +sub parse_access_controls { + my ($access_item) = @_; + my %content; + my $role_id; + my $user; + my $usercount; + my $token; + my $parser=HTML::TokeParser->new(\$access_item); + while ($token=$parser->get_token) { + if ($token->[0] eq 'S') { + my $entry=$token->[1]; + if ($entry eq 'scope') { + my $type = $token->[2]{'type'}; + if (($type eq 'course') || ($type eq 'group')) { + $content{'roles'} = {}; + } + } elsif ($entry eq 'roles') { + $role_id = $token->[2]{id}; + $content{$entry}{$role_id}} = { + role => [], + access => [], + section => [], + group => [], + }; + } elsif ($entry eq 'users') { + $content{'users'} = {}; + $usercount = 0; + } elsif ($entry eq 'user') { + $user = ''; + } else { + my $value=$parser->get_text('/'.$entry); + if ($entry eq 'uname') { + $user = $value; + } elsif ($entry eq 'udom') { + $user .= ':'.$value; + $content{'users'}{$user} = $usercount; + } elsif ($entry eq 'role' || + $entry eq 'access' || + $entry eq 'section' || + $entry eq 'group') { + if ($role_id ne '') { + push(@{$content{'roles'}{$role_id}{$entry}},$value); + } + } elsif ($entry eq 'dom') { + push(@{$content{$entry}},$value); + } else { + $content{$entry}=$value; + } + } + } elsif ($token->[0] eq 'E') { + if ($token->[1] eq 'user') { + $user = ''; + $usercount ++; + } elsif ($token->[1] eq 'roles') { + $role_id = ''; + } + } + } + return %content; +} + +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; + } + } + } + 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 { + $changed_items{$itemnum} = $key; + } + } + } + } + } + # 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 + +sub get_marked_as_readonly { + my ($domain,$user,$what,$group) = @_; + my $current_permissions = &get_portfile_permissions($domain,$user); my @readonly_files; my $cmp1=$what; if (ref($what)) { $cmp1=join('',@{$what}) }; - while (my ($file_name,$value) = each(%current_permissions)) { + while (my ($file_name,$value) = each(%{$current_permissions})) { + if (defined($group)) { + if ($file_name !~ m-^\Q$group\E/-) { + next; + } + } if (ref($value) eq "ARRAY"){ foreach my $stored_what (@{$value}) { my $cmp2=$stored_what; - if (ref($stored_what)) { $cmp2=join('',@{$stored_what}) }; + if (ref($stored_what eq 'ARRAY')) { + $cmp2=join('',@{$stored_what}); + } if ($cmp1 eq $cmp2) { push(@readonly_files, $file_name); + last; } elsif (!defined($what)) { push(@readonly_files, $file_name); + last; } } - } + } } return @readonly_files; } #-----------------------------------------------------------Get Marked as Read Only Hash sub get_marked_as_readonly_hash { - my ($domain,$user,$what) = @_; - my %current_permissions = &dump('file_permissions',$domain,$user); - my ($tmp)=keys(%current_permissions); - if ($tmp=~/^error:/) { undef(%current_permissions); } - + my ($current_permissions,$group,$what) = @_; my %readonly_files; - while (my ($file_name,$value) = each(%current_permissions)) { + while (my ($file_name,$value) = each(%{$current_permissions})) { + if (defined($group)) { + if ($file_name !~ m-^\Q$group\E/-) { + next; + } + } if (ref($value) eq "ARRAY"){ foreach my $stored_what (@{$value}) { - if ($stored_what eq $what) { - $readonly_files{$file_name} = 'locked'; - } elsif (!defined($what)) { - $readonly_files{$file_name} = 'locked'; - } + if (ref($stored_what) eq 'ARRAY') { + 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'; + } + } + } + } } } } @@ -4699,13 +4910,13 @@ sub get_marked_as_readonly_hash { 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) = @_; + my ($domain,$user,$what,$file_name,$group) = @_; my $symb_crs = $what; if (ref($what)) { $symb_crs=join('',@$what); } - my %current_permissions = &dump('file_permissions',$domain,$user); + my %current_permissions = &dump('file_permissions',$domain,$user,$group); my ($tmp)=keys(%current_permissions); if ($tmp=~/^error:/) { undef(%current_permissions); } - my @readonly_files = &get_marked_as_readonly($domain,$user,$what); + 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 $current_locks = $current_permissions{$file}; @@ -4714,9 +4925,11 @@ sub unmark_as_readonly { if (ref($current_locks) eq "ARRAY"){ foreach my $locker (@{$current_locks}) { my $compare=$locker; - if (ref($locker)) { $compare=join('',@{$locker}) }; - if ($compare ne $symb_crs) { - push(@new_locks, $locker); + if (ref($locker) eq 'ARRAY') { + $compare=join('',@{$locker}); + if ($compare ne $symb_crs) { + push(@new_locks, $locker); + } } } if (scalar(@new_locks) > 0) { @@ -7505,6 +7718,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) @@ -7739,6 +7977,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