--- loncom/lond 2004/06/17 11:02:25 1.196 +++ loncom/lond 2004/07/23 16:14:19 1.211 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.196 2004/06/17 11:02:25 foxr Exp $ +# $Id: lond,v 1.211 2004/07/23 16:14:19 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -51,12 +51,12 @@ use LONCAPA::ConfigFileEdit; use LONCAPA::lonlocal; use LONCAPA::lonssl; -my $DEBUG = 11; # Non zero to enable debug log entries. +my $DEBUG = 0; # Non zero to enable debug log entries. my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.196 $'; #' stupid emacs +my $VERSION='$Revision: 1.211 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -69,6 +69,11 @@ my $clientname; # LonCAPA name of clie my $server; my $thisserver; # DNS of us. +my $keymode; + +my $cipher; # Cipher key negotiated with client +my $tmpsnum = 0; # Id of tmpputs. + # # Connection type is: # client - All client actions are allowed @@ -88,6 +93,20 @@ my %managers; # Ip -> manager names my %perlvar; # Will have the apache conf defined perl vars. # +# The hash below is used for command dispatching, and is therefore keyed on the request keyword. +# Each element of the hash contains a reference to an array that contains: +# A reference to a sub that executes the request corresponding to the keyword. +# A flag that is true if the request must be encoded to be acceptable. +# A mask with bits as follows: +# CLIENT_OK - Set when the function is allowed by ordinary clients +# MANAGER_OK - Set when the function is allowed to manager clients. +# +my $CLIENT_OK = 1; +my $MANAGER_OK = 2; +my %Dispatcher; + + +# # The array below are password error strings." # my $lastpwderror = 13; # Largest error number from lcpasswd. @@ -125,6 +144,23 @@ my @adderrors = ("ok", "lcuseradd Password mismatch"); + +# +# Statistics that are maintained and dislayed in the status line. +# +my $Transactions; # Number of attempted transactions. +my $Failures; # Number of transcations failed. + +# ResetStatistics: +# Resets the statistics counters: +# +sub ResetStatistics { + $Transactions = 0; + $Failures = 0; +} + + + #------------------------------------------------------------------------ # # LocalConnection @@ -352,7 +388,6 @@ sub ReadManagerTable { while(my $host = ) { chomp($host); if ($host =~ "^#") { # Comment line. - logthis(' Skipping line: '. "$host\n"); next; } if (!defined $hostip{$host}) { # This is a non cluster member @@ -898,6 +933,216 @@ sub EditFile { return "ok\n"; } + +#--------------------------------------------------------------- +# +# Manipulation of hash based databases (factoring out common code +# for later use as we refactor. +# +# Ties a domain level resource file to a hash. +# If requested a history entry is created in the associated hist file. +# +# Parameters: +# domain - Name of the domain in which the resource file lives. +# namespace - Name of the hash within that domain. +# how - How to tie the hash (e.g. GDBM_WRCREAT()). +# loghead - Optional parameter, if present a log entry is created +# in the associated history file and this is the first part +# of that entry. +# logtail - Goes along with loghead, The actual logentry is of the +# form $loghead::logtail. +# Returns: +# Reference to a hash bound to the db file or alternatively undef +# if the tie failed. +# +sub tie_domain_hash { + my ($domain,$namespace,$how,$loghead,$logtail) = @_; + + # Filter out any whitespace in the domain name: + + $domain =~ s/\W//g; + + # We have enough to go on to tie the hash: + + my $user_top_dir = $perlvar{'lonUsersDir'}; + my $domain_dir = $user_top_dir."/$domain"; + my $resource_file = $domain_dir."/$namespace.db"; + my %hash; + if(tie(%hash, 'GDBM_File', $resource_file, $how, 0640)) { + if (defined($loghead)) { # Need to log the operation. + my $logFh = IO::File->new(">>$domain_dir/$namespace.hist"); + if($logFh) { + my $timestamp = time; + print $logFh "$loghead:$timestamp:$logtail\n"; + } + $logFh->close; + } + return \%hash; # Return the tied hash. + } else { + return undef; # Tie failed. + } +} + +# +# Ties a user's resource file to a hash. +# If necessary, an appropriate history +# log file entry is made as well. +# This sub factors out common code from the subs that manipulate +# the various gdbm files that keep keyword value pairs. +# Parameters: +# domain - Name of the domain the user is in. +# user - Name of the 'current user'. +# namespace - Namespace representing the file to tie. +# how - What the tie is done to (e.g. GDBM_WRCREAT(). +# loghead - Optional first part of log entry if there may be a +# history file. +# what - Optional tail of log entry if there may be a history +# file. +# Returns: +# hash to which the database is tied. It's up to the caller to untie. +# undef if the has could not be tied. +# +sub tie_user_hash { + my ($domain,$user,$namespace,$how,$loghead,$what) = @_; + + $namespace=~s/\//\_/g; # / -> _ + $namespace=~s/\W//g; # whitespace eliminated. + my $proname = propath($domain, $user); + + # Tie the database. + + my %hash; + if(tie(%hash, 'GDBM_File', "$proname/$namespace.db", + $how, 0640)) { + # If this is a namespace for which a history is kept, + # make the history log entry: + if (($namespace =~/^nohist\_/) && (defined($loghead))) { + my $args = scalar @_; + Debug(" Opening history: $namespace $args"); + my $hfh = IO::File->new(">>$proname/$namespace.hist"); + if($hfh) { + my $now = time; + print $hfh "$loghead:$now:$what\n"; + } + $hfh->close; + } + return \%hash; + } else { + return undef; + } + +} +#--------------------------------------------------------------- +# +# Getting, decoding and dispatching requests: +# + +# +# Get a Request: +# Gets a Request message from the client. The transaction +# is defined as a 'line' of text. We remove the new line +# from the text line. +# +sub get_request { + my $input = <$client>; + chomp($input); + + Debug("Request = $input\n"); + + &status('Processing '.$clientname.':'.$input); + + return $input; +} +# +# Decipher encoded traffic +# Parameters: +# input - Encoded data. +# Returns: +# Decoded data or undef if encryption key was not yet negotiated. +# Implicit input: +# cipher - This global holds the negotiated encryption key. +# +sub decipher { + my ($input) = @_; + my $output = ''; + + + if($cipher) { + my($enc, $enclength, $encinput) = split(/:/, $input); + for(my $encidx = 0; $encidx < length($encinput); $encidx += 16) { + $output .= + $cipher->decrypt(pack("H16", substr($encinput, $encidx, 16))); + } + return substr($output, 0, $enclength); + } else { + return undef; + } +} + +# +# Register a command processor. This function is invoked to register a sub +# to process a request. Once registered, the ProcessRequest sub can automatically +# dispatch requests to an appropriate sub, and do the top level validity checking +# as well: +# - Is the keyword recognized. +# - Is the proper client type attempting the request. +# - Is the request encrypted if it has to be. +# Parameters: +# $request_name - Name of the request being registered. +# This is the command request that will match +# against the hash keywords to lookup the information +# associated with the dispatch information. +# $procedure - Reference to a sub to call to process the request. +# All subs get called as follows: +# Procedure($cmd, $tail, $replyfd, $key) +# $cmd - the actual keyword that invoked us. +# $tail - the tail of the request that invoked us. +# $replyfd- File descriptor connected to the client +# $must_encode - True if the request must be encoded to be good. +# $client_ok - True if it's ok for a client to request this. +# $manager_ok - True if it's ok for a manager to request this. +# Side effects: +# - On success, the Dispatcher hash has an entry added for the key $RequestName +# - On failure, the program will die as it's a bad internal bug to try to +# register a duplicate command handler. +# +sub register_handler { + my ($request_name, + $procedure, + $must_encode, + $client_ok, + $manager_ok) = @_; + + # Don't allow duplication# + + if (defined $Dispatcher{$request_name}) { + die "Attempting to define a duplicate request handler for $request_name\n"; + } + # Build the client type mask: + + my $client_type_mask = 0; + if($client_ok) { + $client_type_mask |= $CLIENT_OK; + } + if($manager_ok) { + $client_type_mask |= $MANAGER_OK; + } + + # Enter the hash: + + my @entry = ($procedure, $must_encode, $client_type_mask); + + $Dispatcher{$request_name} = \@entry; + + +} + + +#------------------------------------------------------------------ + + + + # # Convert an error return code from lcpasswd to a string value. # @@ -1218,13 +1463,13 @@ sub logstatus { { my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt"); print $fh $$."\t".$clientname."\t".$currenthostid."\t" - .$status."\t".$lastlog."\n"; + .$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"); @@ -1424,7 +1669,7 @@ while (1) { sub make_new_child { my $pid; - my $cipher; +# my $cipher; # Now global my $sigset; $client = shift; @@ -1483,7 +1728,7 @@ sub make_new_child { sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; - my $tmpsnum=0; +# my $tmpsnum=0; # Now global #---------------------------------------------------- kerberos 5 initialization &Authen::Krb5::init_context(); &Authen::Krb5::init_ets(); @@ -1556,6 +1801,7 @@ sub make_new_child { print $client "ok:local\n"; &logthis('"); + $keymode = "local" } else { Debug("Failed to get local key"); $clientok = 0; @@ -1570,6 +1816,7 @@ sub make_new_child { $cipher = new IDEA($cipherkey); &logthis('' ."Successfull ssl authentication with $clientname "); + $keymode = "ssl"; } else { $clientok = 0; @@ -1583,6 +1830,7 @@ sub make_new_child { &logthis('' ."Successful insecure authentication with $clientname "); print $client "ok\n"; + $keymode = "insecure"; } else { &logthis('' ."Attempted insecure connection disallowed "); @@ -2229,24 +2477,23 @@ sub make_new_child { } elsif ($userinput =~ /^put/) { if(isClient) { my ($cmd,$udom,$uname,$namespace,$what) - =split(/:/,$userinput); + =split(/:/,$userinput,5); $namespace=~s/\//\_/g; $namespace=~s/\W//g; if ($namespace ne 'roles') { chomp($what); my $proname=propath($udom,$uname); my $now=time; - unless ($namespace=~/^nohist\_/) { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname/$namespace.hist") - ) { print $hfh "P:$now:$what\n"; } - } my @pairs=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File', "$proname/$namespace.db", &GDBM_WRCREAT(),0640)) { + unless ($namespace=~/^nohist\_/) { + my $hfh; + if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "P:$now:$what\n"; } + } + foreach my $pair (@pairs) { my ($key,$value)=split(/=/,$pair); $hash{$key}=$value; @@ -2281,17 +2528,15 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); my $now=time; - unless ($namespace=~/^nohist\_/) { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname/$namespace.hist") - ) { print $hfh "P:$now:$what\n"; } - } my @pairs=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File', "$proname/$namespace.db", &GDBM_WRCREAT(),0640)) { + unless ($namespace=~/^nohist\_/) { + my $hfh; + if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "P:$now:$what\n"; } + } foreach my $pair (@pairs) { my ($key,$value)=split(/=/,$pair); # We could check that we have a number... @@ -2333,17 +2578,16 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); my $now=time; - { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname/$namespace.hist") - ) { - print $hfh "P:$now:$exedom:$exeuser:$what\n"; - } - } my @pairs=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { + { + my $hfh; + if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { + print $hfh "P:$now:$exedom:$exeuser:$what\n"; + } + } + foreach my $pair (@pairs) { my ($key,$value)=split(/=/,$pair); &ManagePermissions($key, $udom, $uname, @@ -2384,17 +2628,15 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); my $now=time; - { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname/$namespace.hist") - ) { - print $hfh "D:$now:$exedom:$exeuser:$what\n"; - } - } my @rolekeys=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { + { + my $hfh; + if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { + print $hfh "D:$now:$exedom:$exeuser:$what\n"; + } + } foreach my $key (@rolekeys) { delete $hash{$key}; } @@ -2511,15 +2753,13 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); my $now=time; - unless ($namespace=~/^nohist\_/) { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname/$namespace.hist") - ) { print $hfh "D:$now:$what\n"; } - } my @keys=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { + unless ($namespace=~/^nohist\_/) { + my $hfh; + if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "D:$now:$what\n"; } + } foreach my $key (@keys) { delete($hash{$key}); } @@ -2674,15 +2914,15 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); my $now=time; - unless ($namespace=~/^nohist\_/) { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname/$namespace.hist") - ) { print $hfh "P:$now:$rid:$what\n"; } - } my @pairs=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { + unless ($namespace=~/^nohist\_/) { + my $hfh; + if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { + print $hfh "P:$now:$rid:$what\n"; + } + } my @previouskeys=split(/&/,$hash{"keys:$rid"}); my $key; $hash{"version:$rid"}++; @@ -2831,8 +3071,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"; @@ -2867,14 +3107,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.'&'; } } } @@ -2903,15 +3148,15 @@ sub make_new_child { $udom=~s/\W//g; my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; my $now=time; - { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname.hist") - ) { print $hfh "P:$now:$what\n"; } - } my @pairs=split(/\&/,$what); my %hash; if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) { + { + my $hfh; + if ($hfh=IO::File->new(">>$proname.hist")) { + print $hfh "P:$now:$what\n"; + } + } foreach my $pair (@pairs) { my ($key,$value)=split(/=/,$pair); $hash{$key}=$value; @@ -3028,6 +3273,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.'
'; + } + } else { + $dirContents = "No directory found\n"; + } + print $client $dirContents."\n"; + } else { + Reply($client, "refused\n", $userinput); + } # -------------------------------------------------------------------------- ls } elsif ($userinput =~ /^ls/) { if(isClient) { @@ -3115,53 +3378,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; @@ -3186,6 +3450,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 { @@ -3194,7 +3484,7 @@ sub make_new_child { } # -------------------------------------------------------------------- complete alarm(0); - &status('Listening to '.$clientname); + &status('Listening to '.$clientname." ($keymode)"); } # --------------------------------------------- client unknown or fishy, refuse } else { @@ -3593,6 +3883,73 @@ 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)