Return to lonmsg.pm CVS log

Up to [LON-CAPA] / loncom / interface

Include symb in msgid when sending feedback about a resource.

Include an error bit in msgid (1 if message is a "bomb" caused by an error when rendering a problem.

Include symb and resource title in messsage (<symb> and <resource_title> tags) when feedback is about a resource.

Navigate Contents page now checks for unread feedback or errors using symb instead of just resource url.

Navigate Contents page checks for resource context based on symb in msgid instead of in [url] included in message subject.  Backwards compatibility with old-style messages retained.

Subject for feedback messages about resources appends message title instead of url inside [].

Title on feedback page now avoids leaking unencrypted file name in cases where no title was assigned to a resource with hidden url.

When displaying feedback messages about a resource in a course, "Refers to" link displayed when viewer has corresponding course role selected includes symb in the link. Link text is now resource title.

"Refers to" link points to unencrypted resource url if feedback message is viewed under role other than original course, only if user has bre privilege for the resource, otherwise "Refers to" link is not displayed.

lonfeedback -- Some replacement of decode_symb() and &clutter() and &dewrapper() with &get_feedurl_and_clean_symb() for replies and edits of discussion posts.

lonfeedback -- More work on in ensuring hidden urls are encrypted or unencrypted as required.

# The LearningOnline Network with CAPA
# Routines for messaging
#
# $Id: lonmsg.pm,v 1.191 2006/12/24 22:13:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

package Apache::lonmsg;

use strict;
use Apache::lonnet;
use HTML::TokeParser();
use Apache::lonlocal;
use Mail::Send;
use LONCAPA qw(:DEFAULT :match);

{
    my $uniq;
    sub get_uniq {
	$uniq++;
	return $uniq;
    }
}

# ===================================================================== Package

sub packagemsg {
    my ($subject,$message,$citation,$baseurl,$attachmenturl,
	$recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error)=@_;
    $message =&HTML::Entities::encode($message,'<>&"');
    $citation=&HTML::Entities::encode($citation,'<>&"');
    $subject =&HTML::Entities::encode($subject,'<>&"');
    #remove machine specification
    $baseurl =~ s|^http://[^/]+/|/|;
    $baseurl =&HTML::Entities::encode($baseurl,'<>&"');
    #remove machine specification
    $attachmenturl =~ s|^http://[^/]+/|/|;
    $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
    my $course_context;
    if (defined($env{'form.replyid'})) {
        my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)=
                   split(/\:/,&unescape($env{'form.replyid'}));
        $course_context = $origcid;
    }
    foreach my $key (keys(%env)) {
        if ($key=~/^form\.(rep)?rec\_(.*)$/) {
            my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid) =
                                    split(/\:/,&unescape($2));
            $course_context = $origcid;
            last;
        }
    }
    unless(defined($course_context)) {
        $course_context = $env{'request.course.id'};
    }
    my $now=time;
    my $msgcount = &get_uniq();
    unless(defined($msgid)) {
        $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'},
                           $msgcount,$course_context,$symb,$error,$$);
    }
    my $result = '<sendername>'.$env{'user.name'}.'</sendername>'.
           '<senderdomain>'.$env{'user.domain'}.'</senderdomain>'.
           '<subject>'.$subject.'</subject>'.
           '<time>'.&Apache::lonlocal::locallocaltime($now).'</time>';
    if (defined($crsmsgid)) {
        $result.= '<courseid>'.$course_context.'</courseid>'.
                  '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'.
                  '<msgid>'.$msgid.'</msgid>'.
                  '<coursemsgid>'.$crsmsgid.'</coursemsgid>'.
                  '<message>'.$message.'</message>';
        return ($msgid,$result);
    }
    $result .= '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
           '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
	   '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
	   '<browsertype>'.$env{'browser.type'}.'</browsertype>'.
	   '<browseros>'.$env{'browser.os'}.'</browseros>'.
	   '<browserversion>'.$env{'browser.version'}.'</browserversion>'.
           '<browsermathml>'.$env{'browser.mathml'}.'</browsermathml>'.
	   '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
	   '<courseid>'.$course_context.'</courseid>'.
	   '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'.
	   '<role>'.$env{'request.role'}.'</role>'.
	   '<resource>'.$env{'request.filename'}.'</resource>'.
           '<msgid>'.$msgid.'</msgid>';
    if (ref($recuser) eq 'ARRAY') {
        for (my $i=0; $i<@{$recuser}; $i++) {
            if ($type eq 'dcmail') {
                my ($username,$email) = split(/:/,$$recuser[$i]);
                $username = &unescape($username);
                $email = &unescape($email);
                $username = &HTML::Entities::encode($username,'<>&"');
                $email = &HTML::Entities::encode($email,'<>&"');
                $result .= '<recipient username="'.$username.'">'.
                                            $email.'</recipient>';
            } else {
                $result .= '<recuser>'.$$recuser[$i].'</recuser>'.
                           '<recdomain>'.$$recdomain[$i].'</recdomain>';
            }
        }
    } else {
        $result .= '<recuser>'.$recuser.'</recuser>'.
                   '<recdomain>'.$recdomain.'</recdomain>';
    }
    $result .= '<message>'.$message.'</message>';
    if (defined($citation)) {
	$result.='<citation>'.$citation.'</citation>';
    }
    if (defined($baseurl)) {
	$result.= '<baseurl>'.$baseurl.'</baseurl>';
    }
    if (defined($attachmenturl)) {
	$result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>';
    }
    if (defined($symb)) {
        $result.= '<symb>'.$symb.'</symb>';
        if (defined($course_context)) {
            if ($course_context eq $env{'request.course.id'}) {
                my $resource_title = &Apache::lonnet::gettitle($symb);
                if (defined($resource_title)) {
                    $result .= '<resource_title>'.$resource_title.'</resource_title>';
                }
            }
        }
    }
    return ($msgid,$result);
}

# ================================================== Unpack message into a hash

sub unpackagemsg {
    my ($message,$notoken)=@_;
    my %content=();
    my $parser=HTML::TokeParser->new(\$message);
    my $token;
    while ($token=$parser->get_token) {
       if ($token->[0] eq 'S') {
	   my $entry=$token->[1];
           my $value=$parser->get_text('/'.$entry);
           if (($entry eq 'recuser') || ($entry eq 'recdomain')) {
               push(@{$content{$entry}},$value);
           } elsif ($entry eq 'recipient') {
               my $username = $token->[2]{'username'};
               $username = &HTML::Entities::decode($username,'<>&"');
               $content{$entry}{$username} = $value;
           } else {
               $content{$entry}=$value;
           }
       }
    }
    if (!exists($content{'recuser'})) { $content{'recuser'} = []; }
    if ($content{'attachmenturl'}) {
       my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);
       if ($notoken) {
	   $content{'message'}.='<p>'.&mt('Attachment').': <tt>'.$fname.'</tt>';
       } else {
	   &Apache::lonnet::allowuploaded('/adm/msg',
					  $content{'attachmenturl'});
	   $content{'message'}.='<p>'.&mt('Attachment').
	       ': <a href="'.$content{'attachmenturl'}.'"><tt>'.
	       $fname.'</tt></a>';
       }
    }
    return %content;
}

# ======================================================= Get info out of msgid

sub buildmsgid {
    my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_;
    $subject=&escape($subject);
    return(&escape($now.':'.$subject.':'.$uname.':'.
           $udom.':'.$msgcount.':'.$course_context.':'.$pid.':'.$symb.':'.$error));
}

sub unpackmsgid {
    my ($msgid,$folder,$skipstatus,$status_cache)=@_;
    $msgid=&unescape($msgid);
    my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid,
        $processid,$symb,$error) = split(/\:/,&unescape($msgid));
    $shortsubj = &unescape($shortsubj);
    $shortsubj = &HTML::Entities::decode($shortsubj);
    if (!defined($processid)) { $fromcid = ''; }
    my %status=();
    unless ($skipstatus) {
	if (ref($status_cache)) {
	    $status{$msgid} = $status_cache->{$msgid};
	} else {
	    my $suffix=&foldersuffix($folder);
	    %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]);
	}
	if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
        unless ($status{$msgid}) { $status{$msgid}='new'; }
    }
    return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid,$symb,$error);
}


sub sendemail {
    my ($to,$subject,$body)=@_;
    my %senderemails=&Apache::loncommon::getemails();
    my $senderaddress='';
    foreach my $type ('notification','permanentemail','critnotification') {
	if ($senderemails{$type}) {
	    $senderaddress=$senderemails{$type};
	}
    }
    $body=
    "*** ".&mt('This is an automatic message generated by the LON-CAPA system.')."\n".
    "*** ".($senderaddress?&mt('You can reply to this message'):&mt('Please do not reply to this address.')."\n*** ".
	    &mt('A reply will not be received by the recipient!'))."\n\n".$body;
    my $msg = new Mail::Send;
    $msg->to($to);
    $msg->subject('[LON-CAPA] '.$subject);
    if ($senderaddress) { $msg->add('Reply-to',$senderaddress); $msg->add('From',$senderaddress); }
    if (my $fh = $msg->open()) {
	print $fh $body;
	$fh->close;
    }
}

# ==================================================== Send notification emails

sub sendnotification {
    my ($to,$touname,$toudom,$subj,$crit,$text)=@_;
    my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'};
    unless ($sender=~/\w/) { 
	$sender=$env{'user.name'}.'@'.$env{'user.domain'};
    }
    my $critical=($crit?' critical':'');
    $text=~s/\&lt\;/\</gs;
    $text=~s/\&gt\;/\>/gs;
    $text=~s/\<\/*[^\>]+\>//gs;
    my $url='http://'.
      $Apache::lonnet::hostname{&Apache::lonnet::homeserver($touname,$toudom)}.
      '/adm/email?username='.$touname.'&domain='.$toudom;
    my $body=(<<ENDMSG);
You received a$critical message from $sender in LON-CAPA. The subject is

 $subj

=== Excerpt ============================================================
$text
========================================================================

Use

 $url

to access the full message.
ENDMSG
    &sendemail($to,'New'.$critical.' message from '.$sender,$body);
}
# ============================================================= Check for email

sub newmail {
    if ((time-$env{'user.mailcheck.time'})>300) {
        my %what=&Apache::lonnet::get('email_status',['recnewemail']);
        &Apache::lonnet::appenv('user.mailcheck.time'=>time);
        if ($what{'recnewemail'}>0) { return 1; }
    }
    return 0;
}

# =============================== Automated message to the author of a resource

=pod

=item * B<author_res_msg($filename, $message)>: Sends message $message to the owner
    of the resource with the URI $filename.

=cut

sub author_res_msg {
    my ($filename,$message)=@_;
    unless ($message) { return 'empty'; }
    $filename=&Apache::lonnet::declutter($filename);
    my ($domain,$author,@dummy)=split(/\//,$filename);
    my $homeserver=&Apache::lonnet::homeserver($author,$domain);
    if ($homeserver ne 'no_host') {
       my $id=unpack("%32C*",$message);
       $message .= " <p>This error occurred on machine ".
	   $Apache::lonnet::perlvar{'lonHostID'}."</p>";
       my $msgid;
       ($msgid,$message)=&packagemsg($filename,$message);
       return &Apache::lonnet::reply('put:'.$domain.':'.$author.
         ':nohist_res_msgs:'.
          &escape($filename.'_'.$id).'='.
          &escape($message),$homeserver);
    }
    return 'no_host';
}

# =========================================== Retrieve author resource messages

sub retrieve_author_res_msg {
    my $url=shift;
    $url=&Apache::lonnet::declutter($url);
    my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
    my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author);
    my $msgs='';
    foreach (keys %errormsgs) {
	if ($_=~/^\Q$url\E\_\d+$/) {
	    my %content=&unpackagemsg($errormsgs{$_});
	    $msgs.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'.
		$content{'time'}.'</b>: '.$content{'message'}.
		'<br /></p>';
	}
    } 
    return $msgs;     
}


# =============================== Delete all author messages related to one URL

sub del_url_author_res_msg {
    my $url=shift;
    $url=&Apache::lonnet::declutter($url);
    my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
    my @delmsgs=();
    foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
	if ($_=~/^\Q$url\E\_\d+$/) {
	    push (@delmsgs,$_);
	}
    }
    return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
}
# =================================== Clear out all author messages in URL path

sub clear_author_res_msg {
    my $url=shift;
    $url=&Apache::lonnet::declutter($url);
    my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
    my @delmsgs=();
    foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
	if ($_=~/^\Q$url\E/) {
	    push (@delmsgs,$_);
	}
    }
    return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
}
# ================= Return hash with URLs for which there is a resource message

sub all_url_author_res_msg {
    my ($author,$domain)=@_;
    my %returnhash=();
    foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
	$_=~/^(.+)\_\d+/;
	$returnhash{$1}=1;
    }
    return %returnhash;
}

# ====================================== Add a comment to the User Notes screen

sub store_instructor_comment {
    my ($msg,$uname,$udom) = @_;
    my $cid  = $env{'request.course.id'};
    my $cnum = $env{'course.'.$cid.'.num'};
    my $cdom = $env{'course.'.$cid.'.domain'};
    my $subject= &mt('Record').' ['.$uname.':'.$udom.']';
    my $result = &user_normal_msg_raw($cnum,$cdom,$subject,$msg);
    return $result;
}

# ================================================== Critical message to a user

sub user_crit_msg_raw {
    my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_;
# Check if allowed missing
    my ($status,$packed_message);
    my $msgid='undefined';
    unless (($message)&&($user)&&($domain)) { $status='empty'; };
    my $text=$message;
    my $homeserver=&Apache::lonnet::homeserver($user,$domain);
    if ($homeserver ne 'no_host') {
       ($msgid,$packed_message)=&packagemsg($subject,$message);
       if ($sendback) { $packed_message.='<sendback>true</sendback>'; }
       $status=&Apache::lonnet::critical(
           'put:'.$domain.':'.$user.':critical:'.
           &escape($msgid).'='.
           &escape($packed_message),$homeserver);
        if (defined($sentmessage)) {
            $$sentmessage = $packed_message;
        }
        (undef,my $packed_message_no_citation) =
            &packagemsg($subject,$message,undef,undef,undef,$user,$domain,
                        $msgid);
        $status .= &store_sent_mail($msgid,$packed_message_no_citation);
    } else {
       $status='no_host';
    }

# Notifications
    my %userenv = &Apache::loncommon::getemails($user,$domain);
    if ($userenv{'critnotification'}) {
      &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1,
			$text);
    }
    if ($toperm && $userenv{'permanentemail'}) {
      &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1,
			$text);
    }
# Log this
    &Apache::lonnet::logthis(
      'Sending critical email '.$msgid.
      ', log status: '.
      &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
                         $env{'user.home'},
      'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
      .$status));
    return $status;
}

# New routine that respects "forward" and calls old routine

=pod

=item * B<user_crit_msg($user, $domain, $subject, $message, $sendback)>: Sends
    a critical message $message to the $user at $domain. If $sendback is true,
    a reciept will be sent to the current user when $user recieves the message.

    Additionally it will check if the user has a Forwarding address
    set, and send the message to that address instead

    returns 
      - in array context a list of results for each message that was sent
      - in scalar context a space seperated list of results for each 
           message sent

=cut

sub user_crit_msg {
    my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_;
    my @status;
    my %userenv = &Apache::lonnet::get('environment',['msgforward'],
                                       $domain,$user);
    my $msgforward=$userenv{'msgforward'};
    if ($msgforward) {
       foreach my $addr (split(/\,/,$msgforward)) {
	 my ($forwuser,$forwdomain)=split(/\:/,$addr);
         push(@status,
	      &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message,
				 $sendback,$toperm,$sentmessage));
       }
    } else { 
	push(@status,
	     &user_crit_msg_raw($user,$domain,$subject,$message,$sendback,
				$toperm,$sentmessage));
    }
    if (wantarray) {
	return @status;
    }
    return join(' ',@status);
}

# =================================================== Critical message received

sub user_crit_received {
    my $msgid=shift;
    my %message=&Apache::lonnet::get('critical',[$msgid]);
    my %contents=&unpackagemsg($message{$msgid},1);
    my $status='rec: '.($contents{'sendback'}?
     &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
                     &mt('Receipt').': '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.', '.$contents{'subject'},
                     &mt('User').' '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.
                     ' acknowledged receipt of message'."\n".'   "'.
                     $contents{'subject'}.'"'."\n".&mt('dated').' '.
                     $contents{'time'}.".\n"
                     ):'no msg req');
    $status.=' trans: '.
     &Apache::lonnet::put(
     'nohist_email',{$contents{'msgid'} => $message{$msgid}});
    $status.=' del: '.
     &Apache::lonnet::del('critical',[$contents{'msgid'}]);
    &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
                         $env{'user.home'},'Received critical message '.
                         $contents{'msgid'}.
                         ', '.$status);
    return $status;
}

# ======================================================== Normal communication

sub user_normal_msg_raw {
    my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
        $toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle,
        $error)=@_;
# Check if allowed missing
    my ($status,$packed_message);
    my $msgid='undefined';
    my $text=$message;
    unless (($message)&&($user)&&($domain)) { $status='empty'; };
    my $homeserver=&Apache::lonnet::homeserver($user,$domain);
    if ($homeserver ne 'no_host') {
       ($msgid,$packed_message)=
	                 &packagemsg($subject,$message,$citation,$baseurl,
                                     $attachmenturl,$user,$domain,$currid,
                                     undef,$crsmsgid,$symb,$error);

# Store in user folder
       $status=&Apache::lonnet::critical(
           'put:'.$domain.':'.$user.':nohist_email:'.
           &escape($msgid).'='.
           &escape($packed_message),$homeserver);
# Save new message received time
       &Apache::lonnet::put
                         ('email_status',{'recnewemail'=>time},$domain,$user);
# Into sent-mail folder unless a broadcast message or critical message
       unless (($env{'request.course.id'}) && 
               (($env{'form.sendmode'} eq 'group')  || 
               (($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&
               (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
		|| &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
					    '/'.$env{'request.course.sec'})))) {
           (undef,my $packed_message_no_citation) =
               &packagemsg($subject,$message,undef,$baseurl,$attachmenturl,
                           $user,$domain,$currid,undef,$crsmsgid,$symb,$error);
           $status .= &store_sent_mail($msgid,$packed_message_no_citation);
       }
    } else {
       $status='no_host';
    }
    if (defined($newid)) {
        $$newid = $msgid;
    }
    if (defined($sentmessage)) {
        $$sentmessage = $packed_message;
    }

# Notifications
    my %userenv = &Apache::lonnet::get('environment',['notification',
                                                      'permanentemail'],
                                       $domain,$user);
    if ($userenv{'notification'}) {
	&sendnotification($userenv{'notification'},$user,$domain,$subject,0,
			  $text);
    }
    if ($toperm && $userenv{'permanentemail'}) {
	&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0,
			  $text);
    }
    &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
                         $env{'user.home'},
      'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
    return $status;
}

# New routine that respects "forward" and calls old routine

=pod

=item * B<user_normal_msg($user, $domain, $subject, $message, $citation,
       $baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle, $error)>:
 Sends a message to the  $user at $domain, with subject $subject and message $message.

=cut

sub user_normal_msg {
    my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
	$toperm,$sentmessage,$symb,$restitle,$error)=@_;
    my $status='';
    my %userenv = &Apache::lonnet::get('environment',['msgforward'],
                                       $domain,$user);
    my $msgforward=$userenv{'msgforward'};
    if ($msgforward) {
        foreach (split(/\,/,$msgforward)) {
	    my ($forwuser,$forwdomain)=split(/\:/,$_);
	    $status.=
	        &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,
				     $citation,$baseurl,$attachmenturl,$toperm,
				     undef,undef,$sentmessage,undef,$symb,$restitle,$error).' ';
        }
    } else {
	$status=&user_normal_msg_raw($user,$domain,$subject,$message,
				     $citation,$baseurl,$attachmenturl,$toperm,
				     undef,undef,$sentmessage,undef,$symb,$restitle,$error);
    }
    return $status;
}

sub store_sent_mail {
    my ($msgid,$message) = @_;
    my $status =' '.&Apache::lonnet::critical(
               'put:'.$env{'user.domain'}.':'.$env{'user.name'}.
                                          ':nohist_email_sent:'.
               &escape($msgid).'='.
               &escape($message),$env{'user.home'});
    return $status;
}

# =============================================================== Folder suffix

sub foldersuffix {
    my $folder=shift;
    unless ($folder) { return ''; }
    my $suffix;
    my %folderhash = &get_user_folders($folder);
    if (ref($folderhash{$folder}) eq 'HASH') {
        $suffix = '_'.&escape($folderhash{$folder}{'id'});
    } else {
        $suffix = '_'.&escape($folder);
    }
    return $suffix;
}

# ========================================================= User-defined folders 

sub get_user_folders {
    my ($folder) = @_;
    my %userfolders = 
          &Apache::lonnet::dump('email_folders',undef,undef,$folder);
    my $lock = "\0".'lock_counter'; # locks db while counter incremented
    my $counter = "\0".'idcount';   # used in suffix for email db files
    if (defined($userfolders{$lock})) {
        delete($userfolders{$lock});
    }
    if (defined($userfolders{$counter})) {
        delete($userfolders{$counter});
    }
    return %userfolders;
}

1;
__END__