--- loncom/lonnet/perl/lonnet.pm	2007/01/18 21:02:06	1.828
+++ loncom/lonnet/perl/lonnet.pm	2007/01/29 21:16:55	1.831
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.828 2007/01/18 21:02:06 www Exp $
+# $Id: lonnet.pm,v 1.831 2007/01/29 21:16:55 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -367,6 +367,26 @@ sub transfer_profile_to_env {
     }
 }
 
+sub timed_flock {
+    my ($file,$lock_type) = @_;
+    my $failed=0;
+    eval {
+	local $SIG{__DIE__}='DEFAULT';
+	local $SIG{ALRM}=sub {
+	    $failed=1;
+	    die("failed lock");
+	};
+	alarm(13);
+	flock($file,$lock_type);
+	alarm(0);
+    };
+    if ($failed) {
+	return undef;
+    } else {
+	return 1;
+    }
+}
+
 # ---------------------------------------------------------- Append Environment
 
 sub appenv {
@@ -381,8 +401,11 @@ sub appenv {
             $env{$key}=$newenv{$key};
         }
     }
-    if (tie(my %disk_env,'GDBM_File',$env{'user.environment'},&GDBM_WRITER(),
-	    0640)) {
+    open(my $env_file,$env{'user.environment'});
+    if (&timed_flock($env_file,LOCK_EX)
+	&&
+	tie(my %disk_env,'GDBM_File',$env{'user.environment'},
+	    (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
 	while (my ($key,$value) = each(%newenv)) {
 	    $disk_env{$key} = $value;
 	}
@@ -399,8 +422,11 @@ sub delenv {
                 "Attempt to delete from environment ".$delthis);
         return 'error';
     }
-    if (tie(my %disk_env,'GDBM_File',$env{'user.environment'},&GDBM_WRITER(),
-	    0640)) {
+    open(my $env_file,$env{'user.environment'});
+    if (&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});
@@ -1425,15 +1451,17 @@ sub store_edited_file {
 }
 
 sub clean_filename {
-    my ($fname)=@_;
+    my ($fname,$args)=@_;
 # Replace Windows backslashes by forward slashes
     $fname=~s/\\/\//g;
-# Get rid of everything but the actual filename
-    $fname=~s/^.*\/([^\/]+)$/$1/;
+    if (!$args->{'keep_path'}) {
+        # Get rid of everything but the actual filename
+	$fname=~s/^.*\/([^\/]+)$/$1/;
+    }
 # Replace spaces by underscores
     $fname=~s/\s+/\_/g;
 # Replace all other weird characters by nothing
-    $fname=~s/[^\w\.\-]//g;
+    $fname=~s{[^/\w\.\-]}{}g;
 # Replace all .\d. sequences with _\d. so they no longer look like version
 # numbers
     $fname=~s/\.(\d+)(?=\.)/_$1/g;
@@ -7202,13 +7230,7 @@ sub repcopy_userfile {
     if (-e $transferfile) { return 'ok'; }
     my $request;
     $uri=~s/^\///;
-    if (&homeserver($cnum,$cdom) eq $perlvar{'lonHostID'}) {
-# if this is my own server, get it via tokenwrapper
-        $request=new HTTP::Request('GET',&tokenwrapper('/'.$uri));
-    } else {
-# get it from another server, raw request
-	$request=new HTTP::Request('GET','http://'.$hostname{&homeserver($cnum,$cdom)}.'/raw/'.$uri);
-    }
+    $request=new HTTP::Request('GET','http://'.$hostname{&homeserver($cnum,$cdom)}.'/raw/'.$uri);
     my $response=$ua->request($request,$transferfile);
 # did it work?
     if ($response->is_error()) {