--- loncom/lonnet/perl/lonnet.pm	2007/03/17 04:13:06	1.824.2.3
+++ loncom/lonnet/perl/lonnet.pm	2007/01/18 18:21:10	1.827
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.824.2.3 2007/03/17 04:13:06 albertel Exp $
+# $Id: lonnet.pm,v 1.827 2007/01/18 18:21:10 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -367,26 +367,6 @@ 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 {
@@ -401,11 +381,8 @@ sub appenv {
             $env{$key}=$newenv{$key};
         }
     }
-    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)) {
+    if (tie(my %disk_env,'GDBM_File',$env{'user.environment'},&GDBM_WRITER(),
+	    0640)) {
 	while (my ($key,$value) = each(%newenv)) {
 	    $disk_env{$key} = $value;
 	}
@@ -422,11 +399,8 @@ sub delenv {
                 "Attempt to delete from environment ".$delthis);
         return 'error';
     }
-    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)) {
+    if (tie(my %disk_env,'GDBM_File',$env{'user.environment'},&GDBM_WRITER(),
+	    0640)) {
 	foreach my $key (keys(%disk_env)) {
 	    if ($key=~/^$delthis/) { 
                 delete($env{$key});
@@ -990,16 +964,10 @@ my %remembered;
 my %accessed;
 my $kicks=0;
 my $hits=0;
-sub make_key {
-    my ($name,$id) = @_;
-    if (length($id) > 200) { $id=length($id).':'.&Digest::MD5::md5_hex($id); }
-    return &escape($name.':'.$id);
-}
-
 sub devalidate_cache_new {
     my ($name,$id,$debug) = @_;
     if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); }
-    $id=&make_key($name,$id);
+    $id=&escape($name.':'.$id);
     $memcache->delete($id);
     delete($remembered{$id});
     delete($accessed{$id});
@@ -1007,7 +975,7 @@ sub devalidate_cache_new {
 
 sub is_cached_new {
     my ($name,$id,$debug) = @_;
-    $id=&make_key($name,$id);
+    $id=&escape($name.':'.$id);
     if (exists($remembered{$id})) {
 	if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); }
 	$accessed{$id}=[&gettimeofday()];
@@ -1030,7 +998,7 @@ sub is_cached_new {
 
 sub do_cache_new {
     my ($name,$id,$value,$time,$debug) = @_;
-    $id=&make_key($name,$id);
+    $id=&escape($name.':'.$id);
     my $setvalue=$value;
     if (!defined($setvalue)) {
 	$setvalue='__undef__';
@@ -5348,6 +5316,53 @@ sub modify_access_controls {
     return ($outcome,$deloutcome,\%new_values,\%translation);
 }
 
+sub make_public_indefinitely {
+    my ($requrl) = @_;
+    my $now = time;
+    my $action = 'activate';
+    my $aclnum = 0;
+    if (&is_portfolio_url($requrl)) {
+        my (undef,$udom,$unum,$file_name,$group) =
+            &parse_portfolio_url($requrl);
+        my $current_perms = &get_portfile_permissions($udom,$unum);
+        my %access_controls = &get_access_controls($current_perms,
+                                                   $group,$file_name);
+        foreach my $key (keys(%{$access_controls{$file_name}})) {
+            my ($num,$scope,$end,$start) = 
+                ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
+            if ($scope eq 'public') {
+                if ($start <= $now && $end == 0) {
+                    $action = 'none';
+                } else {
+                    $action = 'update';
+                    $aclnum = $num;
+                }
+                last;
+            }
+        }
+        if ($action eq 'none') {
+             return 'ok';
+        } else {
+            my %changes;
+            my $newend = 0;
+            my $newstart = $now;
+            my $newkey = $aclnum.':public_'.$newend.'_'.$newstart;
+            $changes{$action}{$newkey} = {
+                type => 'public',
+                time => {
+                    start => $newstart,
+                    end   => $newend,
+                },
+            };
+            my ($outcome,$deloutcome,$new_values,$translation) =
+                &modify_access_controls($file_name,\%changes,$udom,$unum);
+            return $outcome;
+        }
+    } else {
+        return 'invalid';
+    }
+}
+
 #------------------------------------------------------Get Marked as Read Only
 
 sub get_marked_as_readonly {
@@ -7173,7 +7188,18 @@ sub repcopy_userfile {
     } else {
 	my $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode);
 	if ($lwpresp ne 'ok') {
-	    return -1;
+	    my $ua=new LWP::UserAgent;
+	    my $request=new HTTP::Request('GET',&tokenwrapper($uri));
+	    # FIXME, right reads everything into memory then writes it out
+	    # doing something like
+	    # 	    my $response=$ua->request($request,$file);
+	    # would make this write directly to disk
+	    my $response=$ua->request($request);
+	    if ($response->is_success()) {
+		$info=$response->content;
+	    } else {
+		return -1;
+	    }
 	}
 	my @parts = ($cdom,$cnum); 
 	if ($filename =~ m|^(.+)/[^/]+$|) {
@@ -7522,7 +7548,7 @@ sub get_iphost {
 	if (!exists($name_to_ip{$name})) {
 	    $ip = gethostbyname($name);
 	    if (!$ip || length($ip) ne 4) {
-		&logthis("Skipping host $id name $name no IP found\n");
+		&logthis("Skipping host $id name $name no IP found");
 		next;
 	    }
 	    $ip=inet_ntoa($ip);