--- loncom/lonnet/perl/lonnet.pm 2007/09/29 04:03:51 1.914 +++ loncom/lonnet/perl/lonnet.pm 2007/10/01 23:53:44 1.917 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.914 2007/09/29 04:03:51 albertel Exp $ +# $Id: lonnet.pm,v 1.917 2007/10/01 23:53:44 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -320,7 +320,10 @@ sub convert_and_load_session_env { my ($lonidsdir,$handle)=@_; my @profile; { - open(my $idf,"$lonidsdir/$handle.id"); + my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id"); + if (!$opened) { + return 0; + } flock($idf,LOCK_SH); @profile=<$idf>; close($idf); @@ -359,7 +362,10 @@ sub transfer_profile_to_env { my $convert; { - open(my $idf,"$lonidsdir/$handle.id"); + my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id"); + if (!$opened) { + return; + } flock($idf,LOCK_SH); if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id", &GDBM_READER(),0640)) { @@ -391,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; @@ -425,8 +459,9 @@ sub appenv { $env{$key}=$newenv{$key}; } } - open(my $env_file,$env{'user.environment'}); - if (&timed_flock($env_file,LOCK_EX) + 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'}, (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) { @@ -446,16 +481,17 @@ sub delenv { "Attempt to delete from environment ".$delthis); return 'error'; } - open(my $env_file,$env{'user.environment'}); - if (&timed_flock($env_file,LOCK_EX) + 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'}, (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) { foreach my $key (keys(%disk_env)) { if ($key=~/^$delthis/) { - delete($env{$key}); - delete($disk_env{$key}); - } + delete($env{$key}); + delete($disk_env{$key}); + } } untie(%disk_env); }