) {
- if (!($configline =~ /^\s*\#/)) {
- my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
- chomp($ip); $ip=~s/\D+$//;
- $hostid{$ip}=$id; # LonCAPA name of host by IP.
- $hostdom{$id}=$domain; # LonCAPA domain name of host.
- $hostip{$id}=$ip; # IP address of host.
- $hostdns{$name} = $id; # LonCAPA name of host by DNS.
-
- if ($id eq $perlvar{'lonHostID'}) {
- Debug("Found me in the host table: $name");
- $thisserver=$name;
- }
- }
- }
- close(CONFIG);
-}
-#
# Reload the Apache daemon's state.
# This is done by invoking /home/httpd/perl/apachereload
# a setuid perl script that can be root for us to do this job.
@@ -3907,13 +5048,11 @@ sub UpdateHosts {
# either dropped or changed hosts. Note that the re-read of the table
# will take care of new and changed hosts as connections come into being.
+ &Apache::lonnet::reset_hosts_info();
- KillHostHashes;
- ReadHostTable;
-
- foreach my $child (keys %children) {
+ foreach my $child (keys(%children)) {
my $childip = $children{$child};
- if(!$hostid{$childip}) {
+ if (!defined(&Apache::lonnet::get_hosts_from_ip($childip))) {
logthis(' UpdateHosts killing child '
." $child for ip $childip ");
kill('INT', $child);
@@ -4002,8 +5141,6 @@ sub Reply {
Debug("Request was $request Reply was $reply");
$Transactions++;
-
-
}
@@ -4046,7 +5183,7 @@ sub logstatus {
flock(LOG,LOCK_EX);
print LOG $$."\t".$clientname."\t".$currenthostid."\t"
.$status."\t".$lastlog."\t $keymode\n";
- flock(DB,LOCK_UN);
+ flock(LOG,LOCK_UN);
close(LOG);
}
&status("Finished logging");
@@ -4075,79 +5212,6 @@ sub status {
$0='lond: '.$what.' '.$local;
}
-# -------------------------------------------------------- Escape Special Chars
-
-sub escape {
- my $str=shift;
- $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
- return $str;
-}
-
-# ----------------------------------------------------- Un-Escape Special Chars
-
-sub unescape {
- my $str=shift;
- $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
- return $str;
-}
-
-# ----------------------------------------------------------- Send USR1 to lonc
-
-sub reconlonc {
- my $peerfile=shift;
- &logthis("Trying to reconnect for $peerfile");
- my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
- if (my $fh=IO::File->new("$loncfile")) {
- my $loncpid=<$fh>;
- chomp($loncpid);
- if (kill 0 => $loncpid) {
- &logthis("lonc at pid $loncpid responding, sending USR1");
- kill USR1 => $loncpid;
- } else {
- &logthis(
- "CRITICAL: "
- ."lonc at pid $loncpid not responding, giving up");
- }
- } else {
- &logthis('CRITICAL: lonc not running, giving up');
- }
-}
-
-# -------------------------------------------------- Non-critical communication
-
-sub subreply {
- my ($cmd,$server)=@_;
- my $peerfile="$perlvar{'lonSockDir'}/$server";
- my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile",
- Type => SOCK_STREAM,
- Timeout => 10)
- or return "con_lost";
- print $sclient "$cmd\n";
- my $answer=<$sclient>;
- chomp($answer);
- if (!$answer) { $answer="con_lost"; }
- return $answer;
-}
-
-sub reply {
- my ($cmd,$server)=@_;
- my $answer;
- if ($server ne $currenthostid) {
- $answer=subreply($cmd,$server);
- if ($answer eq 'con_lost') {
- $answer=subreply("ping",$server);
- if ($answer ne $server) {
- &logthis("sub reply: answer != server answer is $answer, server is $server");
- &reconlonc("$perlvar{'lonSockDir'}/$server");
- }
- $answer=subreply($cmd,$server);
- }
- } else {
- $answer='self_reply';
- }
- return $answer;
-}
-
# -------------------------------------------------------------- Talk to lonsql
sub sql_reply {
@@ -4165,25 +5229,13 @@ sub sub_sql_reply {
Type => SOCK_STREAM,
Timeout => 10)
or return "con_lost";
- print $sclient "$cmd\n";
+ print $sclient "$cmd:$currentdomainid\n";
my $answer=<$sclient>;
chomp($answer);
if (!$answer) { $answer="con_lost"; }
return $answer;
}
-# -------------------------------------------- Return path to profile directory
-
-sub propath {
- my ($udom,$uname)=@_;
- $udom=~s/\W//g;
- $uname=~s/\W//g;
- my $subdir=$uname.'__';
- $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
- my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
- return $proname;
-}
-
# --------------------------------------- Is this the home server of an author?
sub ishome {
@@ -4228,8 +5280,9 @@ $SIG{USR1} = \&checkchildren;
$SIG{USR2} = \&UpdateHosts;
# Read the host hashes:
+&Apache::lonnet::load_hosts_tab();
-ReadHostTable;
+my $dist=`$perlvar{'lonDaemons'}/distprobe`;
# --------------------------------------------------------------
# Accept connections. When a connection comes in, it is validated
@@ -4277,8 +5330,6 @@ sub make_new_child {
if (defined($iaddr)) {
$clientip = inet_ntoa($iaddr);
Debug("Connected with $clientip");
- $clientdns = gethostbyaddr($iaddr, AF_INET);
- Debug("Connected with $clientdns by name");
} else {
&logthis("Unable to determine clientip");
$clientip='Unavailable';
@@ -4308,7 +5359,10 @@ sub make_new_child {
# my $tmpsnum=0; # Now global
#---------------------------------------------------- kerberos 5 initialization
&Authen::Krb5::init_context();
- &Authen::Krb5::init_ets();
+ unless (($dist eq 'fedora5') || ($dist eq 'fedora4') ||
+ ($dist eq 'fedora6') || ($dist eq 'suse9.3')) {
+ &Authen::Krb5::init_ets();
+ }
&status('Accepted connection');
# =============================================================================
@@ -4316,20 +5370,23 @@ sub make_new_child {
# -----------------------------------------------------------------------------
# see if we know client and 'check' for spoof IP by ineffective challenge
- ReadManagerTable; # May also be a manager!!
-
- my $clientrec=($hostid{$clientip} ne undef);
- my $ismanager=($managers{$clientip} ne undef);
+ my $outsideip=$clientip;
+ if ($clientip eq '127.0.0.1') {
+ $outsideip=&Apache::lonnet::get_host_ip($perlvar{'lonHostID'});
+ }
+
+ my $clientrec=defined(&Apache::lonnet::get_hosts_from_ip($outsideip));
+ my $ismanager=($managers{$outsideip} ne undef);
$clientname = "[unknonwn]";
if($clientrec) { # Establish client type.
$ConnectionType = "client";
- $clientname = $hostid{$clientip};
+ $clientname = (&Apache::lonnet::get_hosts_from_ip($outsideip))[-1];
if($ismanager) {
$ConnectionType = "both";
}
} else {
$ConnectionType = "manager";
- $clientname = $managers{$clientip};
+ $clientname = $managers{$outsideip};
}
my $clientok;
@@ -4342,7 +5399,7 @@ sub make_new_child {
my $remotereq=<$client>;
chomp($remotereq);
Debug("Got init: $remotereq");
- my $inikeyword = split(/:/, $remotereq);
+
if ($remotereq =~ /^init/) {
&sethost("sethost:$perlvar{'lonHostID'}");
#
@@ -4430,14 +5487,9 @@ sub make_new_child {
if ($clientok) {
# ---------------- New known client connecting, could mean machine online again
-
- foreach my $id (keys(%hostip)) {
- if ($hostip{$id} ne $clientip ||
- $hostip{$currenthostid} eq $clientip) {
- # no need to try to do recon's to myself
- next;
- }
- &reconlonc("$perlvar{'lonSockDir'}/$id");
+ if (&Apache::lonnet::get_host_ip($currenthostid) ne $clientip
+ && $clientip ne '127.0.0.1') {
+ &Apache::lonnet::reconlonc();
}
&logthis("Established connection: $clientname");
&status('Will listen to '.$clientname);
@@ -4473,8 +5525,38 @@ sub make_new_child {
exit;
}
+#
+# Determine if a user is an author for the indicated domain.
+#
+# Parameters:
+# domain - domain to check in .
+# user - Name of user to check.
+#
+# Return:
+# 1 - User is an author for domain.
+# 0 - User is not an author for domain.
+sub is_author {
+ my ($domain, $user) = @_;
+
+ &Debug("is_author: $user @ $domain");
+
+ my $hashref = &tie_user_hash($domain, $user, "roles",
+ &GDBM_READER());
+
+ # Author role should show up as a key /domain/_au
+
+ my $key = "/$domain/_au";
+ my $value;
+ if (defined($hashref)) {
+ $value = $hashref->{$key};
+ }
+ if(defined($value)) {
+ &Debug("$user @ $domain is an author");
+ }
+ return defined($value);
+}
#
# Checks to see if the input roleput request was to set
# an author role. If so, invokes the lchtmldir script to set
@@ -4486,16 +5568,17 @@ sub make_new_child {
# user - Name of the user for which the role is being put.
# authtype - The authentication type associated with the user.
#
-sub manage_permissions
-{
-
+sub manage_permissions {
my ($request, $domain, $user, $authtype) = @_;
+ &Debug("manage_permissions: $request $domain $user $authtype");
+
# See if the request is of the form /$domain/_au
- if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...
+ if($request =~ /^(\/\Q$domain\E\/_au)$/) { # It's an author rolesput...
my $execdir = $perlvar{'lonDaemons'};
my $userhome= "/home/$user" ;
&logthis("system $execdir/lchtmldir $userhome $user $authtype");
+ &Debug("Setting homedir permissions for $userhome");
system("$execdir/lchtmldir $userhome $user $authtype");
}
}
@@ -4511,12 +5594,7 @@ sub manage_permissions
#
sub password_path {
my ($domain, $user) = @_;
-
-
- my $path = &propath($domain, $user);
- $path .= "/passwd";
-
- return $path;
+ return &propath($domain, $user).'/passwd';
}
# Password Filename
@@ -4591,12 +5669,7 @@ sub get_auth_type
Debug("Password info = $realpassword\n");
my ($authtype, $contentpwd) = split(/:/, $realpassword);
Debug("Authtype = $authtype, content = $contentpwd\n");
- my $availinfo = '';
- if($authtype eq 'krb4' or $authtype eq 'krb5') {
- $availinfo = $contentpwd;
- }
-
- return "$authtype:$availinfo";
+ return "$authtype:$contentpwd";
} else {
Debug("Returning nouser");
return "nouser";
@@ -4629,7 +5702,8 @@ sub validate_user {
# At the end of this function. I'll ensure that it's not still that
# value so we don't just wind up returning some accidental value
# as a result of executing an unforseen code path that
- # did not set $validated.
+ # did not set $validated. At the end of valid execution paths,
+ # validated shoule be 1 for success or 0 for failuer.
my $validated = -3.14159;
@@ -4692,8 +5766,9 @@ sub validate_user {
my $krbservice = "krbtgt/".$contentpwd."\@".$contentpwd;
my $krbserver = &Authen::Krb5::parse_name($krbservice);
my $credentials= &Authen::Krb5::cc_default();
- $credentials->initialize($krbclient);
- my $krbreturn = &Authen::KRb5::get_in_tkt_with_password($krbclient,
+ $credentials->initialize(&Authen::Krb5::parse_name($user.'@'
+ .$contentpwd));
+ my $krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient,
$krbserver,
$password,
$credentials);
@@ -4705,7 +5780,12 @@ sub validate_user {
# Authenticate via installation specific authentcation method:
$validated = &localauth::localauth($user,
$password,
- $contentpwd);
+ $contentpwd,
+ $domain);
+ if ($validated < 0) {
+ &logthis("localauth for $contentpwd $user:$domain returned a $validated");
+ $validated = 0;
+ }
} else { # Unrecognized auth is also bad.
$validated = 0;
}
@@ -4717,7 +5797,11 @@ sub validate_user {
#
unless ($validated != -3.14159) {
- die "ValidateUser - failed to set the value of validated";
+ # I >really really< want to know if this happens.
+ # since it indicates that user authentication is badly
+ # broken in some code path.
+ #
+ die "ValidateUser - failed to set the value of validated $domain, $user $password";
}
return $validated;
}
@@ -4727,8 +5811,7 @@ sub addline {
my ($fname,$hostid,$ip,$newline)=@_;
my $contents;
my $found=0;
- my $expr='^'.$hostid.':'.$ip.':';
- $expr =~ s/\./\\\./g;
+ my $expr='^'.quotemeta($hostid).':'.quotemeta($ip).':';
my $sh;
if ($sh=IO::File->new("$fname.subscription")) {
while (my $subline=<$sh>) {
@@ -4744,39 +5827,51 @@ sub addline {
}
sub get_chat {
- my ($cdom,$cname,$udom,$uname)=@_;
- my %hash;
- my $proname=&propath($cdom,$cname);
+ my ($cdom,$cname,$udom,$uname,$group)=@_;
+
my @entries=();
- if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
- &GDBM_READER(),0640)) {
- @entries=map { $_.':'.$hash{$_} } sort keys %hash;
- untie %hash;
+ my $namespace = 'nohist_chatroom';
+ my $namespace_inroom = 'nohist_inchatroom';
+ if ($group ne '') {
+ $namespace .= '_'.$group;
+ $namespace_inroom .= '_'.$group;
+ }
+ my $hashref = &tie_user_hash($cdom, $cname, $namespace,
+ &GDBM_READER());
+ if ($hashref) {
+ @entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
+ &untie_user_hash($hashref);
}
my @participants=();
my $cutoff=time-60;
- if (tie(%hash,'GDBM_File',"$proname/nohist_inchatroom.db",
- &GDBM_WRCREAT(),0640)) {
- $hash{$uname.':'.$udom}=time;
- foreach (sort keys %hash) {
- if ($hash{$_}>$cutoff) {
- $participants[$#participants+1]='active_participant:'.$_;
+ $hashref = &tie_user_hash($cdom, $cname, $namespace_inroom,
+ &GDBM_WRCREAT());
+ if ($hashref) {
+ $hashref->{$uname.':'.$udom}=time;
+ foreach my $user (sort(keys(%$hashref))) {
+ if ($hashref->{$user}>$cutoff) {
+ push(@participants, 'active_participant:'.$user);
}
}
- untie %hash;
+ &untie_user_hash($hashref);
}
return (@participants,@entries);
}
sub chat_add {
- my ($cdom,$cname,$newchat)=@_;
- my %hash;
- my $proname=&propath($cdom,$cname);
+ my ($cdom,$cname,$newchat,$group)=@_;
my @entries=();
my $time=time;
- if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
- &GDBM_WRCREAT(),0640)) {
- @entries=map { $_.':'.$hash{$_} } sort keys %hash;
+ my $namespace = 'nohist_chatroom';
+ my $logfile = 'chatroom.log';
+ if ($group ne '') {
+ $namespace .= '_'.$group;
+ $logfile = 'chatroom_'.$group.'.log';
+ }
+ my $hashref = &tie_user_hash($cdom, $cname, $namespace,
+ &GDBM_WRCREAT());
+ if ($hashref) {
+ @entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);
my ($thentime,$idnum)=split(/\_/,$lastid);
my $newid=$time.'_000000';
@@ -4786,21 +5881,22 @@ sub chat_add {
$idnum=substr('000000'.$idnum,-6,6);
$newid=$time.'_'.$idnum;
}
- $hash{$newid}=$newchat;
+ $hashref->{$newid}=$newchat;
my $expired=$time-3600;
- foreach (keys %hash) {
- my ($thistime)=($_=~/(\d+)\_/);
+ foreach my $comment (keys(%$hashref)) {
+ my ($thistime) = ($comment=~/(\d+)\_/);
if ($thistime<$expired) {
- delete $hash{$_};
+ delete $hashref->{$comment};
}
}
- untie %hash;
- }
- {
- my $hfh;
- if ($hfh=IO::File->new(">>$proname/chatroom.log")) {
- print $hfh "$time:".&unescape($newchat)."\n";
+ {
+ my $proname=&propath($cdom,$cname);
+ if (open(CHATLOG,">>$proname/$logfile")) {
+ print CHATLOG ("$time:".&unescape($newchat)."\n");
+ }
+ close(CHATLOG);
}
+ &untie_user_hash($hashref);
}
}
@@ -4889,7 +5985,7 @@ sub thisversion {
sub subscribe {
my ($userinput,$clientip)=@_;
my $result;
- my ($cmd,$fname)=split(/:/,$userinput);
+ my ($cmd,$fname)=split(/:/,$userinput,2);
my $ownership=&ishome($fname);
if ($ownership eq 'owner') {
# explitly asking for the current version?
@@ -4933,6 +6029,35 @@ sub subscribe {
}
return $result;
}
+# Change the passwd of a unix user. The caller must have
+# first verified that the user is a loncapa user.
+#
+# Parameters:
+# user - Unix user name to change.
+# pass - New password for the user.
+# Returns:
+# ok - if success
+# other - Some meaningfule error message string.
+# NOTE:
+# invokes a setuid script to change the passwd.
+sub change_unix_password {
+ my ($user, $pass) = @_;
+
+ &Debug("change_unix_password");
+ my $execdir=$perlvar{'lonDaemons'};
+ &Debug("Opening lcpasswd pipeline");
+ my $pf = IO::File->new("|$execdir/lcpasswd > "
+ ."$perlvar{'lonDaemons'}"
+ ."/logs/lcpasswd.log");
+ print $pf "$user\n$pass\n$pass\n";
+ close $pf;
+ my $err = $?;
+ return ($err < @passwderrors) ? $passwderrors[$err] :
+ "pwchange_falure - unknown error";
+
+
+}
+
sub make_passwd_file {
my ($uname, $umode,$npass,$passfilename)=@_;
@@ -4940,7 +6065,11 @@ sub make_passwd_file {
if ($umode eq 'krb4' or $umode eq 'krb5') {
{
my $pf = IO::File->new(">$passfilename");
- print $pf "$umode:$npass\n";
+ if ($pf) {
+ print $pf "$umode:$npass\n";
+ } else {
+ $result = "pass_file_failed_error";
+ }
}
} elsif ($umode eq 'internal') {
my $salt=time;
@@ -4949,12 +6078,20 @@ sub make_passwd_file {
{
&Debug("Creating internal auth");
my $pf = IO::File->new(">$passfilename");
- print $pf "internal:$ncpass\n";
+ if($pf) {
+ print $pf "internal:$ncpass\n";
+ } else {
+ $result = "pass_file_failed_error";
+ }
}
} elsif ($umode eq 'localauth') {
{
my $pf = IO::File->new(">$passfilename");
- print $pf "localauth:$npass\n";
+ if($pf) {
+ print $pf "localauth:$npass\n";
+ } else {
+ $result = "pass_file_failed_error";
+ }
}
} elsif ($umode eq 'unix') {
{
@@ -4980,26 +6117,40 @@ sub make_passwd_file {
print $se "$npass\n";
print $se "$lc_error_file\n"; # Status -> unique file.
}
- my $error = IO::File->new("< $lc_error_file");
- my $useraddok = <$error>;
- $error->close;
- unlink($lc_error_file);
-
- chomp $useraddok;
-
- if($useraddok > 0) {
- my $error_text = &lcuseraddstrerror($useraddok);
- &logthis("Failed lcuseradd: $error_text");
- $result = "lcuseradd_failed:$error_text\n";
+ if (-r $lc_error_file) {
+ &Debug("Opening error file: $lc_error_file");
+ my $error = IO::File->new("< $lc_error_file");
+ my $useraddok = <$error>;
+ $error->close;
+ unlink($lc_error_file);
+
+ chomp $useraddok;
+
+ if($useraddok > 0) {
+ my $error_text = &lcuseraddstrerror($useraddok);
+ &logthis("Failed lcuseradd: $error_text");
+ $result = "lcuseradd_failed:$error_text\n";
+ } else {
+ my $pf = IO::File->new(">$passfilename");
+ if($pf) {
+ print $pf "unix:\n";
+ } else {
+ $result = "pass_file_failed_error";
+ }
+ }
} else {
- my $pf = IO::File->new(">$passfilename");
- print $pf "unix:\n";
+ &Debug("Could not locate lcuseradd error: $lc_error_file");
+ $result="bug_lcuseradd_no_output_file";
}
}
} elsif ($umode eq 'none') {
{
my $pf = IO::File->new("> $passfilename");
- print $pf "none:\n";
+ if($pf) {
+ print $pf "none:\n";
+ } else {
+ $result = "pass_file_failed_error";
+ }
}
} else {
$result="auth_mode_error\n";
@@ -5007,13 +6158,24 @@ sub make_passwd_file {
return $result;
}
+sub convert_photo {
+ my ($start,$dest)=@_;
+ system("convert $start $dest");
+}
+
sub sethost {
my ($remotereq) = @_;
my (undef,$hostid)=split(/:/,$remotereq);
+ # ignore sethost if we are already correct
+ if ($hostid eq $currenthostid) {
+ return 'ok';
+ }
+
if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }
- if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {
+ if (&Apache::lonnet::get_host_ip($perlvar{'lonHostID'})
+ eq &Apache::lonnet::get_host_ip($hostid)) {
$currenthostid =$hostid;
- $currentdomainid=$hostdom{$hostid};
+ $currentdomainid=&Apache::lonnet::host_domain($hostid);
&logthis("Setting hostid to $hostid, and domain to $currentdomainid");
} else {
&logthis("Requested host id $hostid not an alias of ".
@@ -5029,96 +6191,6 @@ sub version {
return "version:$VERSION";
}
-#There is a copy of this in lonnet.pm
-sub userload {
- my $numusers=0;
- {
- opendir(LONIDS,$perlvar{'lonIDsDir'});
- my $filename;
- my $curtime=time;
- while ($filename=readdir(LONIDS)) {
- if ($filename eq '.' || $filename eq '..') {next;}
- my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9];
- if ($curtime-$mtime < 1800) { $numusers++; }
- }
- closedir(LONIDS);
- }
- my $userloadpercent=0;
- my $maxuserload=$perlvar{'lonUserLoadLim'};
- if ($maxuserload) {
- $userloadpercent=100*$numusers/$maxuserload;
- }
- $userloadpercent=sprintf("%.2f",$userloadpercent);
- return $userloadpercent;
-}
-
-# Routines for serializing arrays and hashes (copies from lonnet)
-
-sub array2str {
- my (@array) = @_;
- my $result=&arrayref2str(\@array);
- $result=~s/^__ARRAY_REF__//;
- $result=~s/__END_ARRAY_REF__$//;
- return $result;
-}
-
-sub arrayref2str {
- my ($arrayref) = @_;
- my $result='__ARRAY_REF__';
- foreach my $elem (@$arrayref) {
- if(ref($elem) eq 'ARRAY') {
- $result.=&arrayref2str($elem).'&';
- } elsif(ref($elem) eq 'HASH') {
- $result.=&hashref2str($elem).'&';
- } elsif(ref($elem)) {
- #print("Got a ref of ".(ref($elem))." skipping.");
- } else {
- $result.=&escape($elem).'&';
- }
- }
- $result=~s/\&$//;
- $result .= '__END_ARRAY_REF__';
- return $result;
-}
-
-sub hash2str {
- my (%hash) = @_;
- my $result=&hashref2str(\%hash);
- $result=~s/^__HASH_REF__//;
- $result=~s/__END_HASH_REF__$//;
- return $result;
-}
-
-sub hashref2str {
- my ($hashref)=@_;
- my $result='__HASH_REF__';
- foreach (sort(keys(%$hashref))) {
- if (ref($_) eq 'ARRAY') {
- $result.=&arrayref2str($_).'=';
- } elsif (ref($_) eq 'HASH') {
- $result.=&hashref2str($_).'=';
- } elsif (ref($_)) {
- $result.='=';
- #print("Got a ref of ".(ref($_))." skipping.");
- } else {
- if ($_) {$result.=&escape($_).'=';} else { last; }
- }
-
- if(ref($hashref->{$_}) eq 'ARRAY') {
- $result.=&arrayref2str($hashref->{$_}).'&';
- } elsif(ref($hashref->{$_}) eq 'HASH') {
- $result.=&hashref2str($hashref->{$_}).'&';
- } elsif(ref($hashref->{$_})) {
- $result.='&';
- #print("Got a ref of ".(ref($hashref->{$_}))." skipping.");
- } else {
- $result.=&escape($hashref->{$_}).'&';
- }
- }
- $result=~s/\&$//;
- $result .= '__END_HASH_REF__';
- return $result;
-}
# ----------------------------------- POD (plain old documentation, CPAN style)
@@ -5435,7 +6507,6 @@ to the client, and the connection is clo
IO::Socket
IO::File
Apache::File
-Symbol
POSIX
Crypt::IDEA
LWP::UserAgent()
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.