--- loncom/lonnet/perl/lonnet.pm 2007/10/01 21:06:04 1.915
+++ loncom/lonnet/perl/lonnet.pm 2007/10/03 19:57:26 1.918
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.915 2007/10/01 21:06:04 albertel Exp $
+# $Id: lonnet.pm,v 1.918 2007/10/03 19:57:26 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -320,8 +320,8 @@ sub convert_and_load_session_env {
my ($lonidsdir,$handle)=@_;
my @profile;
{
- open(my $idf,'+<',"$lonidsdir/$handle.id");
- if (!$idf) {
+ my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
+ if (!$opened) {
return 0;
}
flock($idf,LOCK_SH);
@@ -362,8 +362,8 @@ sub transfer_profile_to_env {
my $convert;
{
- open(my $idf,'+<',"$lonidsdir/$handle.id");
- if (!$idf) {
+ my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
+ if (!$opened) {
return;
}
flock($idf,LOCK_SH);
@@ -397,6 +397,34 @@ sub transfer_profile_to_env {
}
}
+# ---------------------------------------------------- Check for valid session
+sub check_for_valid_session {
+ my ($r) = @_;
+ my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
+ my $lonid=$cookies{'lonID'};
+ return undef if (!$lonid);
+
+ my $handle=&LONCAPA::clean_handle($lonid->value);
+ my $lonidsdir=$r->dir_config('lonIDsDir');
+ return undef if (!-e "$lonidsdir/$handle.id");
+
+ my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
+ return undef if (!$opened);
+
+ flock($idf,LOCK_SH);
+ my %disk_env;
+ if (!tie(%disk_env,'GDBM_File',"$lonidsdir/$handle.id",
+ &GDBM_READER(),0640)) {
+ return undef;
+ }
+
+ if (!defined($disk_env{'user.name'})
+ || !defined($disk_env{'user.domain'})) {
+ return undef;
+ }
+ return $handle;
+}
+
sub timed_flock {
my ($file,$lock_type) = @_;
my $failed=0;
@@ -431,8 +459,8 @@ sub appenv {
$env{$key}=$newenv{$key};
}
}
- open(my $env_file,'+<',$env{'user.environment'});
- if ($env_file
+ my $opened = open(my $env_file,'+<',$env{'user.environment'});
+ if ($opened
&& &timed_flock($env_file,LOCK_EX)
&&
tie(my %disk_env,'GDBM_File',$env{'user.environment'},
@@ -453,8 +481,8 @@ sub delenv {
"Attempt to delete from environment ".$delthis);
return 'error';
}
- open(my $env_file,'+<',$env{'user.environment'});
- if ($env_file
+ my $opened = open(my $env_file,'+<',$env{'user.environment'});
+ if ($opened
&& &timed_flock($env_file,LOCK_EX)
&&
tie(my %disk_env,'GDBM_File',$env{'user.environment'},
@@ -2155,23 +2183,20 @@ sub flushcourselogs {
delete $courselogs{$crsid};
}
}
- if ($courseidbuffer{$coursehombuf{$crsid}}) {
- $courseidbuffer{$coursehombuf{$crsid}}.='&'.
- &escape($crsid).'='.&escape($coursedescrbuf{$crsid}).
- ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}).':'.&escape($coursetypebuf{$crsid});
- } else {
- $courseidbuffer{$coursehombuf{$crsid}}=
- &escape($crsid).'='.&escape($coursedescrbuf{$crsid}).
- ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}).':'.&escape($coursetypebuf{$crsid});
- }
+ $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = (
+ 'description' => &escape($coursedescrbuf{$crsid}),
+ 'instcode' => &escape($courseinstcodebuf{$crsid}),
+ 'type' => &escape($coursetypebuf{$crsid}),
+ 'owner' => &escape($courseownerbuf{$crsid}),
+ );
}
#
# Write course id database (reverse lookup) to homeserver of courses
# Is used in pickcourse
#
foreach my $crs_home (keys(%courseidbuffer)) {
- &courseidput(&host_domain($crs_home),$courseidbuffer{$crs_home},
- $crs_home);
+ my $response = &courseidput(&host_domain($crs_home),
+ $courseidbuffer{$crs_home},$crs_home);
}
#
# File accesses
@@ -2477,31 +2502,65 @@ sub getannounce {
#
sub courseidput {
- my ($domain,$what,$coursehome)=@_;
- return &reply('courseidput:'.$domain.':'.$what,$coursehome);
+ my ($domain,$storehash,$coursehome)=@_;
+ my $items='';
+ my $now = time;
+ foreach my $item (keys(%$storehash)) {
+ $storehash->{$item}{'lasttime'} = $now;
+ $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
+ }
+ $items=~s/\&$//;
+ my $outcome = &reply('courseidputhash:'.$domain.':'.$items,$coursehome);
+ if ($outcome eq 'unknown_cmd') {
+ my $what;
+ foreach my $cid (keys(%$storehash)) {
+ $what .= &escape($cid).'=';
+ foreach my $item ('description','instcode','owner','type') {
+ $what .= $storehash->{$item}.':';
+ }
+ $what =~ s/\:$/&/;
+ }
+ $what =~ s/\&$//;
+ return &reply('courseidput:'.$domain.':'.$what,$coursehome);
+ } else {
+ return $outcome;
+ }
}
sub courseiddump {
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
- my %returnhash=();
- unless ($domfilter) { $domfilter=''; }
+ my $as_hash = 1;
+ my %returnhash;
+ if (!$domfilter) { $domfilter=''; }
my %libserv = &all_library();
foreach my $tryserver (keys(%libserv)) {
if ( ( $hostidflag == 1
&& grep(/^\Q$tryserver\E$/,@{$hostidref}) )
|| (!defined($hostidflag)) ) {
- if ($domfilter eq ''
- || (&host_domain($tryserver) eq $domfilter)) {
- foreach my $line (
- split(/\&/,&reply('courseiddump:'.&host_domain($tryserver).':'.
- $sincefilter.':'.&escape($descfilter).':'.
- &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter).':'.&escape($regexp_ok),
- $tryserver))) {
- my ($key,$value)=split(/\=/,$line,2);
- if (($key) && ($value)) {
- $returnhash{&unescape($key)}=$value;
- }
+ if (($domfilter eq '') ||
+ (&host_domain($tryserver) eq $domfilter)) {
+ my $rep =
+ &reply('courseiddump:'.&host_domain($tryserver).':'.
+ $sincefilter.':'.&escape($descfilter).':'.
+ &escape($instcodefilter).':'.&escape($ownerfilter).
+ ':'.&escape($coursefilter).':'.&escape($typefilter).
+ ':'.&escape($regexp_ok).':'.$as_hash,$tryserver);
+ my @pairs=split(/\&/,$rep);
+ foreach my $item (@pairs) {
+ my ($key,$value)=split(/\=/,$item,2);
+ $key = &unescape($key);
+ next if ($key =~ /^error: 2 /);
+ my $result = &thaw_unescape($value);
+ if (ref($result) eq 'HASH') {
+ $returnhash{$key}=$result;
+ } else {
+ my @responses = split(/:/,$result);
+ my @items = ('description','instcode','owner','type');
+ for (my $i=0; $i<@responses; $i++) {
+ $returnhash{$key}{$items[$i]} = $responses[$i];
+ }
+ }
}
}
}
@@ -4947,10 +5006,16 @@ sub auto_instcode_defaults {
}
sub auto_validate_class_sec {
- my ($cdom,$cnum,$owner,$inst_class) = @_;
+ my ($cdom,$cnum,$owners,$inst_class) = @_;
my $homeserver = &homeserver($cnum,$cdom);
+ my $ownerlist;
+ if (ref($owners) eq 'ARRAY') {
+ $ownerlist = join(',',@{$owners});
+ } else {
+ $ownerlist = $owners;
+ }
my $response=&reply('autovalidateclass_sec:'.$inst_class.':'.
- &escape($owner).':'.$cdom,$homeserver);
+ &escape($ownerlist).':'.$cdom,$homeserver);
return $response;
}
@@ -5479,9 +5544,15 @@ sub createcourse {
}
# ----------------------------------------------------------------- Course made
# log existence
- &courseidput($udom,&escape($udom.'_'.$uname).'='.&escape($description).
- ':'.&escape($inst_code).':'.&escape($course_owner).':'.
- &escape($crstype),$uhome);
+ my $newcourse = {
+ $udom.'_'.$uname => {
+ description => &escape($description),
+ inst_code => &escape($inst_code),
+ owner => &escape($course_owner),
+ type => &escape($crstype),
+ },
+ };
+ &courseidput($udom,$newcourse);
&flushcourselogs();
# set toplevel url
my $topurl=$url;
@@ -5512,7 +5583,7 @@ ENDINITMAP
sub is_course {
my ($cdom,$cnum) = @_;
my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef,
- undef,'.');
+ undef,'.',undef,1);
if (exists($courses{$cdom.'_'.$cnum})) {
return 1;
}