--- loncom/lond 2004/06/08 22:09:44 1.193
+++ loncom/lond 2004/07/22 23:08:43 1.206
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.193 2004/06/08 22:09:44 raeburn Exp $
+# $Id: lond,v 1.206 2004/07/22 23:08:43 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -48,23 +48,28 @@ use localauth;
use localenroll;
use File::Copy;
use LONCAPA::ConfigFileEdit;
+use LONCAPA::lonlocal;
+use LONCAPA::lonssl;
my $DEBUG = 0; # Non zero to enable debug log entries.
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.193 $'; #' stupid emacs
+my $VERSION='$Revision: 1.206 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid;
my $currentdomainid;
my $client;
-my $clientip;
-my $clientname;
+my $clientip; # IP address of client.
+my $clientdns; # DNS name of client.
+my $clientname; # LonCAPA name of client.
my $server;
-my $thisserver;
+my $thisserver; # DNS of us.
+
+my $keymode;
#
# Connection type is:
@@ -75,9 +80,10 @@ my $thisserver;
my $ConnectionType;
-my %hostid;
-my %hostdom;
-my %hostip;
+my %hostid; # ID's for hosts in cluster by ip.
+my %hostdom; # LonCAPA domain for hosts in cluster.
+my %hostip; # IPs for hosts in cluster.
+my %hostdns; # ID's of hosts looked up by DNS name.
my %managers; # Ip -> manager names
@@ -121,6 +127,178 @@ my @adderrors = ("ok",
"lcuseradd Password mismatch");
+#------------------------------------------------------------------------
+#
+# LocalConnection
+# Completes the formation of a locally authenticated connection.
+# This function will ensure that the 'remote' client is really the
+# local host. If not, the connection is closed, and the function fails.
+# If so, initcmd is parsed for the name of a file containing the
+# IDEA session key. The fie is opened, read, deleted and the session
+# key returned to the caller.
+#
+# Parameters:
+# $Socket - Socket open on client.
+# $initcmd - The full text of the init command.
+#
+# Implicit inputs:
+# $clientdns - The DNS name of the remote client.
+# $thisserver - Our DNS name.
+#
+# Returns:
+# IDEA session key on success.
+# undef on failure.
+#
+sub LocalConnection {
+ my ($Socket, $initcmd) = @_;
+ Debug("Attempting local connection: $initcmd client: $clientdns me: $thisserver");
+ if($clientdns ne $thisserver) {
+ &logthis('<font color="red"> LocalConnection rejecting non local: '
+ ."$clientdns ne $thisserver </font>");
+ close $Socket;
+ return undef;
+ }
+ else {
+ chomp($initcmd); # Get rid of \n in filename.
+ my ($init, $type, $name) = split(/:/, $initcmd);
+ Debug(" Init command: $init $type $name ");
+
+ # Require that $init = init, and $type = local: Otherwise
+ # the caller is insane:
+
+ if(($init ne "init") && ($type ne "local")) {
+ &logthis('<font color = "red"> LocalConnection: caller is insane! '
+ ."init = $init, and type = $type </font>");
+ close($Socket);;
+ return undef;
+
+ }
+ # Now get the key filename:
+
+ my $IDEAKey = lonlocal::ReadKeyFile($name);
+ return $IDEAKey;
+ }
+}
+#------------------------------------------------------------------------------
+#
+# SSLConnection
+# Completes the formation of an ssh authenticated connection. The
+# socket is promoted to an ssl socket. If this promotion and the associated
+# certificate exchange are successful, the IDEA key is generated and sent
+# to the remote peer via the SSL tunnel. The IDEA key is also returned to
+# the caller after the SSL tunnel is torn down.
+#
+# Parameters:
+# Name Type Purpose
+# $Socket IO::Socket::INET Plaintext socket.
+#
+# Returns:
+# IDEA key on success.
+# undef on failure.
+#
+sub SSLConnection {
+ my $Socket = shift;
+
+ Debug("SSLConnection: ");
+ my $KeyFile = lonssl::KeyFile();
+ if(!$KeyFile) {
+ my $err = lonssl::LastError();
+ &logthis("<font color=\"red\"> CRITICAL"
+ ."Can't get key file $err </font>");
+ return undef;
+ }
+ my ($CACertificate,
+ $Certificate) = lonssl::CertificateFile();
+
+
+ # If any of the key, certificate or certificate authority
+ # certificate filenames are not defined, this can't work.
+
+ if((!$Certificate) || (!$CACertificate)) {
+ my $err = lonssl::LastError();
+ &logthis("<font color=\"red\"> CRITICAL"
+ ."Can't get certificates: $err </font>");
+
+ return undef;
+ }
+ Debug("Key: $KeyFile CA: $CACertificate Cert: $Certificate");
+
+ # Indicate to our peer that we can procede with
+ # a transition to ssl authentication:
+
+ print $Socket "ok:ssl\n";
+
+ Debug("Approving promotion -> ssl");
+ # And do so:
+
+ my $SSLSocket = lonssl::PromoteServerSocket($Socket,
+ $CACertificate,
+ $Certificate,
+ $KeyFile);
+ if(! ($SSLSocket) ) { # SSL socket promotion failed.
+ my $err = lonssl::LastError();
+ &logthis("<font color=\"red\"> CRITICAL "
+ ."SSL Socket promotion failed: $err </font>");
+ return undef;
+ }
+ Debug("SSL Promotion successful");
+
+ #
+ # The only thing we'll use the socket for is to send the IDEA key
+ # to the peer:
+
+ my $Key = lonlocal::CreateCipherKey();
+ print $SSLSocket "$Key\n";
+
+ lonssl::Close($SSLSocket);
+
+ Debug("Key exchange complete: $Key");
+
+ return $Key;
+}
+#
+# InsecureConnection:
+# If insecure connections are allowd,
+# exchange a challenge with the client to 'validate' the
+# client (not really, but that's the protocol):
+# We produce a challenge string that's sent to the client.
+# The client must then echo the challenge verbatim to us.
+#
+# Parameter:
+# Socket - Socket open on the client.
+# Returns:
+# 1 - success.
+# 0 - failure (e.g.mismatch or insecure not allowed).
+#
+sub InsecureConnection {
+ my $Socket = shift;
+
+ # Don't even start if insecure connections are not allowed.
+
+ if(! $perlvar{londAllowInsecure}) { # Insecure connections not allowed.
+ return 0;
+ }
+
+ # Fabricate a challenge string and send it..
+
+ my $challenge = "$$".time; # pid + time.
+ print $Socket "$challenge\n";
+ &status("Waiting for challenge reply");
+
+ my $answer = <$Socket>;
+ $answer =~s/\W//g;
+ if($challenge eq $answer) {
+ return 1;
+ }
+ else {
+ logthis("<font color='blue'>WARNING client did not respond to challenge</font>");
+ &status("No challenge reqply");
+ return 0;
+ }
+
+
+}
+
#
# GetCertificate: Given a transaction that requires a certificate,
# this function will extract the certificate from the transaction
@@ -176,7 +354,6 @@ sub ReadManagerTable {
while(my $host = <MANAGERS>) {
chomp($host);
if ($host =~ "^#") { # Comment line.
- logthis('<font color="green"> Skipping line: '. "$host</font>\n");
next;
}
if (!defined $hostip{$host}) { # This is a non cluster member
@@ -351,6 +528,8 @@ sub InstallFile {
return 1;
}
+
+
#
# ConfigFileFromSelector: converts a configuration file selector
# (one of host or domain at this point) into a
@@ -864,7 +1043,7 @@ sub HUPSMAN { # sig
#
# Kill off hashes that describe the host table prior to re-reading it.
# Hashes affected are:
-# %hostid, %hostdom %hostip
+# %hostid, %hostdom %hostip %hostdns.
#
sub KillHostHashes {
foreach my $key (keys %hostid) {
@@ -876,6 +1055,9 @@ sub KillHostHashes {
foreach my $key (keys %hostip) {
delete $hostip{$key};
}
+ foreach my $key (keys %hostdns) {
+ delete $hostdns{$key};
+ }
}
#
# Read in the host table from file and distribute it into the various hashes:
@@ -886,15 +1068,21 @@ sub KillHostHashes {
sub ReadHostTable {
open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
-
+ my $myloncapaname = $perlvar{'lonHostID'};
+ Debug("My loncapa name is : $myloncapaname");
while (my $configline=<CONFIG>) {
if (!($configline =~ /^\s*\#/)) {
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
chomp($ip); $ip=~s/\D+$//;
- $hostid{$ip}=$id;
- $hostdom{$id}=$domain;
- $hostip{$id}=$ip;
- if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
+ $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);
@@ -1030,13 +1218,14 @@ sub logstatus {
my $docdir=$perlvar{'lonDocRoot'};
{
my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");
- print $fh $$."\t".$clientname."\t".$currenthostid."\t".$status."\t".$lastlog."\n";
+ print $fh $$."\t".$clientname."\t".$currenthostid."\t"
+ .$status."\t".$lastlog."\t $keymode\n";
$fh->close();
}
&status("Finished londstatus.txt");
{
my $fh=IO::File->new(">$docdir/lon-status/londchld/$$.txt");
- print $fh $status."\n".$lastlog."\n".time;
+ print $fh $status."\n".$lastlog."\n".time."\n$keymode";
$fh->close();
}
&status("Finished logging");
@@ -1265,9 +1454,12 @@ sub make_new_child {
&logthis("Unable to determine who caller was, getpeername returned nothing");
}
if (defined($iaddr)) {
- $clientip=inet_ntoa($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 clinetip");
+ &logthis("Unable to determine clientip");
$clientip='Unavailable';
}
@@ -1301,7 +1493,7 @@ sub make_new_child {
# =============================================================================
# do something with the connection
# -----------------------------------------------------------------------------
- # see if we know client and check for spoof IP by challenge
+ # see if we know client and 'check' for spoof IP by ineffective challenge
ReadManagerTable; # May also be a manager!!
@@ -1319,6 +1511,7 @@ sub make_new_child {
$clientname = $managers{$clientip};
}
my $clientok;
+
if ($clientrec || $ismanager) {
&status("Waiting for init from $clientip $clientname");
&logthis('<font color="yellow">INFO: Connection, '.
@@ -1326,22 +1519,81 @@ sub make_new_child {
" ($clientname) connection type = $ConnectionType </font>" );
&status("Connecting $clientip ($clientname))");
my $remotereq=<$client>;
- $remotereq=~s/[^\w:]//g;
+ chomp($remotereq);
+ Debug("Got init: $remotereq");
+ my $inikeyword = split(/:/, $remotereq);
if ($remotereq =~ /^init/) {
&sethost("sethost:$perlvar{'lonHostID'}");
- my $challenge="$$".time;
- print $client "$challenge\n";
- &status(
- "Waiting for challenge reply from $clientip ($clientname)");
- $remotereq=<$client>;
- $remotereq=~s/\W//g;
- if ($challenge eq $remotereq) {
- $clientok=1;
- print $client "ok\n";
+ #
+ # If the remote is attempting a local init... give that a try:
+ #
+ my ($i, $inittype) = split(/:/, $remotereq);
+
+ # If the connection type is ssl, but I didn't get my
+ # certificate files yet, then I'll drop back to
+ # insecure (if allowed).
+
+ if($inittype eq "ssl") {
+ my ($ca, $cert) = lonssl::CertificateFile;
+ my $kfile = lonssl::KeyFile;
+ if((!$ca) ||
+ (!$cert) ||
+ (!$kfile)) {
+ $inittype = ""; # This forces insecure attempt.
+ &logthis("<font color=\"blue\"> Certificates not "
+ ."installed -- trying insecure auth</font>");
+ }
+ else { # SSL certificates are in place so
+ } # Leave the inittype alone.
+ }
+
+ if($inittype eq "local") {
+ my $key = LocalConnection($client, $remotereq);
+ if($key) {
+ Debug("Got local key $key");
+ $clientok = 1;
+ my $cipherkey = pack("H32", $key);
+ $cipher = new IDEA($cipherkey);
+ print $client "ok:local\n";
+ &logthis('<font color="green"'
+ . "Successful local authentication </font>");
+ $keymode = "local"
+ } else {
+ Debug("Failed to get local key");
+ $clientok = 0;
+ shutdown($client, 3);
+ close $client;
+ }
+ } elsif ($inittype eq "ssl") {
+ my $key = SSLConnection($client);
+ if ($key) {
+ $clientok = 1;
+ my $cipherkey = pack("H32", $key);
+ $cipher = new IDEA($cipherkey);
+ &logthis('<font color="green">'
+ ."Successfull ssl authentication with $clientname </font>");
+ $keymode = "ssl";
+
+ } else {
+ $clientok = 0;
+ close $client;
+ }
+
} else {
- &logthis(
- "<font color='blue'>WARNING: $clientip did not reply challenge</font>");
- &status('No challenge reply '.$clientip);
+ my $ok = InsecureConnection($client);
+ if($ok) {
+ $clientok = 1;
+ &logthis('<font color="green">'
+ ."Successful insecure authentication with $clientname </font>");
+ print $client "ok\n";
+ $keymode = "insecure";
+ } else {
+ &logthis('<font color="yellow">'
+ ."Attempted insecure connection disallowed </font>");
+ close $client;
+ $clientok = 0;
+
+ }
}
} else {
&logthis(
@@ -1349,11 +1601,13 @@ sub make_new_child {
."$clientip failed to initialize: >$remotereq< </font>");
&status('No init '.$clientip);
}
+
} else {
&logthis(
"<font color='blue'>WARNING: Unknown client $clientip</font>");
&status('Hung up on '.$clientip);
}
+
if ($clientok) {
# ---------------- New known client connecting, could mean machine online again
@@ -1978,11 +2232,14 @@ sub make_new_child {
# ------------------------------------------------------------------------- put
} elsif ($userinput =~ /^put/) {
if(isClient) {
- my ($cmd,$udom,$uname,$namespace,$what)
+ my ($cmd,$udom,$uname,$namespace,$what,@extras)
=split(/:/,$userinput);
$namespace=~s/\//\_/g;
$namespace=~s/\W//g;
if ($namespace ne 'roles') {
+ if (@extras) {
+ $what .= ':'.join(':',@extras);
+ }
chomp($what);
my $proname=propath($udom,$uname);
my $now=time;
@@ -2581,8 +2838,8 @@ sub make_new_child {
my %hash;
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
foreach my $pair (@pairs) {
- my ($key,$value)=split(/=/,$pair);
- $hash{$key}=$value.':'.$now;
+ my ($key,$descr,$inst_code)=split(/=/,$pair);
+ $hash{$key}=$descr.':'.$inst_code.':'.$now;
}
if (untie(%hash)) {
print $client "ok\n";
@@ -2617,14 +2874,19 @@ sub make_new_child {
my %hash;
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
while (my ($key,$value) = each(%hash)) {
- my ($descr,$lasttime)=split(/\:/,$value);
+ my ($descr,$lasttime,$inst_code);
+ if ($value =~ m/^([^\:]*):([^\:]*):(\d+)$/) {
+ ($descr,$inst_code,$lasttime)=($1,$2,$3);
+ } else {
+ ($descr,$lasttime) = split(/\:/,$value);
+ }
if ($lasttime<$since) { next; }
if ($description eq '.') {
- $qresult.=$key.'='.$descr.'&';
+ $qresult.=$key.'='.$descr.':'.$inst_code.'&';
} else {
my $unescapeVal = &unescape($descr);
if (eval('$unescapeVal=~/\Q$description\E/i')) {
- $qresult.="$key=$descr&";
+ $qresult.=$key.'='.$descr.':'.$inst_code.'&';
}
}
}
@@ -2778,6 +3040,24 @@ sub make_new_child {
Reply($client, "refused\n", $userinput);
}
+# ----------------------------------------- portfolio directory list (portls)
+ } elsif ($userinput =~ /^portls/) {
+ if(isClient) {
+ my ($cmd,$uname,$udom)=split(/:/,$userinput);
+ my $udir=propath($udom,$uname).'/userfiles/portfolio';
+ my $dirLine='';
+ my $dirContents='';
+ if (opendir(LSDIR,$udir.'/')){
+ while ($dirLine = readdir(LSDIR)){
+ $dirContents = $dirContents.$dirLine.'<br />';
+ }
+ } else {
+ $dirContents = "No directory found\n";
+ }
+ print $client $dirContents."\n";
+ } else {
+ Reply($client, "refused\n", $userinput);
+ }
# -------------------------------------------------------------------------- ls
} elsif ($userinput =~ /^ls/) {
if(isClient) {
@@ -2865,53 +3145,54 @@ sub make_new_child {
print $client "refused\n";
}
#------------------------------- is auto-enrollment enabled?
- } elsif ($userinput =~/^autorun/) {
+ } elsif ($userinput =~/^autorun:/) {
if (isClient) {
- my $outcome = &localenroll::run();
+ my ($cmd,$cdom) = split(/:/,$userinput);
+ my $outcome = &localenroll::run($cdom);
print $client "$outcome\n";
} else {
print $client "0\n";
}
#------------------------------- get official sections (for auto-enrollment).
- } elsif ($userinput =~/^autogetsections/) {
+ } elsif ($userinput =~/^autogetsections:/) {
if (isClient) {
- my ($cmd,$coursecode)=split(/:/,$userinput);
- my @secs = &localenroll::get_sections($coursecode);
+ my ($cmd,$coursecode,$cdom)=split(/:/,$userinput);
+ my @secs = &localenroll::get_sections($coursecode,$cdom);
my $seclist = &escape(join(':',@secs));
print $client "$seclist\n";
} else {
print $client "refused\n";
}
#----------------------- validate owner of new course section (for auto-enrollment).
- } elsif ($userinput =~/^autonewcourse/) {
+ } elsif ($userinput =~/^autonewcourse:/) {
if (isClient) {
- my ($cmd,$course_id,$owner)=split(/:/,$userinput);
- my $outcome = &localenroll::new_course($course_id,$owner);
+ my ($cmd,$inst_course_id,$owner,$cdom)=split(/:/,$userinput);
+ my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);
print $client "$outcome\n";
} else {
print $client "refused\n";
}
#-------------- validate course section in schedule of classes (for auto-enrollment).
- } elsif ($userinput =~/^autovalidatecourse/) {
+ } elsif ($userinput =~/^autovalidatecourse:/) {
if (isClient) {
- my ($cmd,$course_id)=split(/:/,$userinput);
- my $outcome=&localenroll::validate_courseID($course_id);
+ my ($cmd,$inst_course_id,$cdom)=split(/:/,$userinput);
+ my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom);
print $client "$outcome\n";
} else {
print $client "refused\n";
}
#--------------------------- create password for new user (for auto-enrollment).
- } elsif ($userinput =~/^autocreatepassword/) {
+ } elsif ($userinput =~/^autocreatepassword:/) {
if (isClient) {
- my ($cmd,$authparam)=split(/:/,$userinput);
- my ($create_passwd,$authchk) = @_;
- ($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam);
+ my ($cmd,$authparam,$cdom)=split(/:/,$userinput);
+ my ($create_passwd,$authchk);
+ ($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam,$cdom);
print $client &escape($authparam.':'.$create_passwd.':'.$authchk)."\n";
} else {
print $client "refused\n";
}
#--------------------------- read and remove temporary files (for auto-enrollment).
- } elsif ($userinput =~/^autoretrieve/) {
+ } elsif ($userinput =~/^autoretrieve:/) {
if (isClient) {
my ($cmd,$filename) = split(/:/,$userinput);
my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename;
@@ -2936,6 +3217,32 @@ sub make_new_child {
} else {
print $client "refused\n";
}
+#--------------------- read and retrieve institutional code format (for support form).
+ } elsif ($userinput =~/^autoinstcodeformat:/) {
+ if (isClient) {
+ my $reply;
+ my($cmd,$cdom,$course) = split(/:/,$userinput);
+ my @pairs = split/\&/,$course;
+ my %instcodes = ();
+ my %codes = ();
+ my @codetitles = ();
+ my %cat_titles = ();
+ my %cat_order = ();
+ foreach (@pairs) {
+ my ($key,$value) = split/=/,$_;
+ $instcodes{&unescape($key)} = &unescape($value);
+ }
+ my $formatreply = &localenroll::instcode_format($cdom,\%instcodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);
+ if ($formatreply eq 'ok') {
+ my $codes_str = &hash2str(%codes);
+ my $codetitles_str = &array2str(@codetitles);
+ my $cat_titles_str = &hash2str(%cat_titles);
+ my $cat_order_str = &hash2str(%cat_order);
+ print $client $codes_str.':'.$codetitles_str.':'.$cat_titles_str.':'.$cat_order_str."\n";
+ }
+ } else {
+ print $client "refused\n";
+ }
# ------------------------------------------------------------- unknown command
} else {
@@ -2944,7 +3251,7 @@ sub make_new_child {
}
# -------------------------------------------------------------------- complete
alarm(0);
- &status('Listening to '.$clientname);
+ &status('Listening to '.$clientname." ($keymode)");
}
# --------------------------------------------- client unknown or fishy, refuse
} else {
@@ -3303,7 +3610,7 @@ sub sethost {
my (undef,$hostid)=split(/:/,$remotereq);
if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }
if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {
- $currenthostid=$hostid;
+ $currenthostid =$hostid;
$currentdomainid=$hostdom{$hostid};
&logthis("Setting hostid to $hostid, and domain to $currentdomainid");
} else {
@@ -3343,6 +3650,74 @@ sub userload {
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)
=head1 NAME