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.

    1: # The LearningOnline Network with CAPA
    2: # Routines for messaging
    3: #
    4: # $Id: lonmsg.pm,v 1.191 2006/12/24 22:13:19 raeburn Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: 
   29: package Apache::lonmsg;
   30: 
   31: use strict;
   32: use Apache::lonnet;
   33: use HTML::TokeParser();
   34: use Apache::lonlocal;
   35: use Mail::Send;
   36: use LONCAPA qw(:DEFAULT :match);
   37: 
   38: {
   39:     my $uniq;
   40:     sub get_uniq {
   41: 	$uniq++;
   42: 	return $uniq;
   43:     }
   44: }
   45: 
   46: # ===================================================================== Package
   47: 
   48: sub packagemsg {
   49:     my ($subject,$message,$citation,$baseurl,$attachmenturl,
   50: 	$recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error)=@_;
   51:     $message =&HTML::Entities::encode($message,'<>&"');
   52:     $citation=&HTML::Entities::encode($citation,'<>&"');
   53:     $subject =&HTML::Entities::encode($subject,'<>&"');
   54:     #remove machine specification
   55:     $baseurl =~ s|^http://[^/]+/|/|;
   56:     $baseurl =&HTML::Entities::encode($baseurl,'<>&"');
   57:     #remove machine specification
   58:     $attachmenturl =~ s|^http://[^/]+/|/|;
   59:     $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
   60:     my $course_context;
   61:     if (defined($env{'form.replyid'})) {
   62:         my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)=
   63:                    split(/\:/,&unescape($env{'form.replyid'}));
   64:         $course_context = $origcid;
   65:     }
   66:     foreach my $key (keys(%env)) {
   67:         if ($key=~/^form\.(rep)?rec\_(.*)$/) {
   68:             my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid) =
   69:                                     split(/\:/,&unescape($2));
   70:             $course_context = $origcid;
   71:             last;
   72:         }
   73:     }
   74:     unless(defined($course_context)) {
   75:         $course_context = $env{'request.course.id'};
   76:     }
   77:     my $now=time;
   78:     my $msgcount = &get_uniq();
   79:     unless(defined($msgid)) {
   80:         $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'},
   81:                            $msgcount,$course_context,$symb,$error,$$);
   82:     }
   83:     my $result = '<sendername>'.$env{'user.name'}.'</sendername>'.
   84:            '<senderdomain>'.$env{'user.domain'}.'</senderdomain>'.
   85:            '<subject>'.$subject.'</subject>'.
   86:            '<time>'.&Apache::lonlocal::locallocaltime($now).'</time>';
   87:     if (defined($crsmsgid)) {
   88:         $result.= '<courseid>'.$course_context.'</courseid>'.
   89:                   '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'.
   90:                   '<msgid>'.$msgid.'</msgid>'.
   91:                   '<coursemsgid>'.$crsmsgid.'</coursemsgid>'.
   92:                   '<message>'.$message.'</message>';
   93:         return ($msgid,$result);
   94:     }
   95:     $result .= '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
   96:            '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
   97: 	   '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
   98: 	   '<browsertype>'.$env{'browser.type'}.'</browsertype>'.
   99: 	   '<browseros>'.$env{'browser.os'}.'</browseros>'.
  100: 	   '<browserversion>'.$env{'browser.version'}.'</browserversion>'.
  101:            '<browsermathml>'.$env{'browser.mathml'}.'</browsermathml>'.
  102: 	   '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
  103: 	   '<courseid>'.$course_context.'</courseid>'.
  104: 	   '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'.
  105: 	   '<role>'.$env{'request.role'}.'</role>'.
  106: 	   '<resource>'.$env{'request.filename'}.'</resource>'.
  107:            '<msgid>'.$msgid.'</msgid>';
  108:     if (ref($recuser) eq 'ARRAY') {
  109:         for (my $i=0; $i<@{$recuser}; $i++) {
  110:             if ($type eq 'dcmail') {
  111:                 my ($username,$email) = split(/:/,$$recuser[$i]);
  112:                 $username = &unescape($username);
  113:                 $email = &unescape($email);
  114:                 $username = &HTML::Entities::encode($username,'<>&"');
  115:                 $email = &HTML::Entities::encode($email,'<>&"');
  116:                 $result .= '<recipient username="'.$username.'">'.
  117:                                             $email.'</recipient>';
  118:             } else {
  119:                 $result .= '<recuser>'.$$recuser[$i].'</recuser>'.
  120:                            '<recdomain>'.$$recdomain[$i].'</recdomain>';
  121:             }
  122:         }
  123:     } else {
  124:         $result .= '<recuser>'.$recuser.'</recuser>'.
  125:                    '<recdomain>'.$recdomain.'</recdomain>';
  126:     }
  127:     $result .= '<message>'.$message.'</message>';
  128:     if (defined($citation)) {
  129: 	$result.='<citation>'.$citation.'</citation>';
  130:     }
  131:     if (defined($baseurl)) {
  132: 	$result.= '<baseurl>'.$baseurl.'</baseurl>';
  133:     }
  134:     if (defined($attachmenturl)) {
  135: 	$result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>';
  136:     }
  137:     if (defined($symb)) {
  138:         $result.= '<symb>'.$symb.'</symb>';
  139:         if (defined($course_context)) {
  140:             if ($course_context eq $env{'request.course.id'}) {
  141:                 my $resource_title = &Apache::lonnet::gettitle($symb);
  142:                 if (defined($resource_title)) {
  143:                     $result .= '<resource_title>'.$resource_title.'</resource_title>';
  144:                 }
  145:             }
  146:         }
  147:     }
  148:     return ($msgid,$result);
  149: }
  150: 
  151: # ================================================== Unpack message into a hash
  152: 
  153: sub unpackagemsg {
  154:     my ($message,$notoken)=@_;
  155:     my %content=();
  156:     my $parser=HTML::TokeParser->new(\$message);
  157:     my $token;
  158:     while ($token=$parser->get_token) {
  159:        if ($token->[0] eq 'S') {
  160: 	   my $entry=$token->[1];
  161:            my $value=$parser->get_text('/'.$entry);
  162:            if (($entry eq 'recuser') || ($entry eq 'recdomain')) {
  163:                push(@{$content{$entry}},$value);
  164:            } elsif ($entry eq 'recipient') {
  165:                my $username = $token->[2]{'username'};
  166:                $username = &HTML::Entities::decode($username,'<>&"');
  167:                $content{$entry}{$username} = $value;
  168:            } else {
  169:                $content{$entry}=$value;
  170:            }
  171:        }
  172:     }
  173:     if (!exists($content{'recuser'})) { $content{'recuser'} = []; }
  174:     if ($content{'attachmenturl'}) {
  175:        my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);
  176:        if ($notoken) {
  177: 	   $content{'message'}.='<p>'.&mt('Attachment').': <tt>'.$fname.'</tt>';
  178:        } else {
  179: 	   &Apache::lonnet::allowuploaded('/adm/msg',
  180: 					  $content{'attachmenturl'});
  181: 	   $content{'message'}.='<p>'.&mt('Attachment').
  182: 	       ': <a href="'.$content{'attachmenturl'}.'"><tt>'.
  183: 	       $fname.'</tt></a>';
  184:        }
  185:     }
  186:     return %content;
  187: }
  188: 
  189: # ======================================================= Get info out of msgid
  190: 
  191: sub buildmsgid {
  192:     my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_;
  193:     $subject=&escape($subject);
  194:     return(&escape($now.':'.$subject.':'.$uname.':'.
  195:            $udom.':'.$msgcount.':'.$course_context.':'.$pid.':'.$symb.':'.$error));
  196: }
  197: 
  198: sub unpackmsgid {
  199:     my ($msgid,$folder,$skipstatus,$status_cache)=@_;
  200:     $msgid=&unescape($msgid);
  201:     my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid,
  202:         $processid,$symb,$error) = split(/\:/,&unescape($msgid));
  203:     $shortsubj = &unescape($shortsubj);
  204:     $shortsubj = &HTML::Entities::decode($shortsubj);
  205:     if (!defined($processid)) { $fromcid = ''; }
  206:     my %status=();
  207:     unless ($skipstatus) {
  208: 	if (ref($status_cache)) {
  209: 	    $status{$msgid} = $status_cache->{$msgid};
  210: 	} else {
  211: 	    my $suffix=&foldersuffix($folder);
  212: 	    %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]);
  213: 	}
  214: 	if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
  215:         unless ($status{$msgid}) { $status{$msgid}='new'; }
  216:     }
  217:     return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid,$symb,$error);
  218: }
  219: 
  220: 
  221: sub sendemail {
  222:     my ($to,$subject,$body)=@_;
  223:     my %senderemails=&Apache::loncommon::getemails();
  224:     my $senderaddress='';
  225:     foreach my $type ('notification','permanentemail','critnotification') {
  226: 	if ($senderemails{$type}) {
  227: 	    $senderaddress=$senderemails{$type};
  228: 	}
  229:     }
  230:     $body=
  231:     "*** ".&mt('This is an automatic message generated by the LON-CAPA system.')."\n".
  232:     "*** ".($senderaddress?&mt('You can reply to this message'):&mt('Please do not reply to this address.')."\n*** ".
  233: 	    &mt('A reply will not be received by the recipient!'))."\n\n".$body;
  234:     my $msg = new Mail::Send;
  235:     $msg->to($to);
  236:     $msg->subject('[LON-CAPA] '.$subject);
  237:     if ($senderaddress) { $msg->add('Reply-to',$senderaddress); $msg->add('From',$senderaddress); }
  238:     if (my $fh = $msg->open()) {
  239: 	print $fh $body;
  240: 	$fh->close;
  241:     }
  242: }
  243: 
  244: # ==================================================== Send notification emails
  245: 
  246: sub sendnotification {
  247:     my ($to,$touname,$toudom,$subj,$crit,$text)=@_;
  248:     my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'};
  249:     unless ($sender=~/\w/) { 
  250: 	$sender=$env{'user.name'}.'@'.$env{'user.domain'};
  251:     }
  252:     my $critical=($crit?' critical':'');
  253:     $text=~s/\&lt\;/\</gs;
  254:     $text=~s/\&gt\;/\>/gs;
  255:     $text=~s/\<\/*[^\>]+\>//gs;
  256:     my $url='http://'.
  257:       $Apache::lonnet::hostname{&Apache::lonnet::homeserver($touname,$toudom)}.
  258:       '/adm/email?username='.$touname.'&domain='.$toudom;
  259:     my $body=(<<ENDMSG);
  260: You received a$critical message from $sender in LON-CAPA. The subject is
  261: 
  262:  $subj
  263: 
  264: === Excerpt ============================================================
  265: $text
  266: ========================================================================
  267: 
  268: Use
  269: 
  270:  $url
  271: 
  272: to access the full message.
  273: ENDMSG
  274:     &sendemail($to,'New'.$critical.' message from '.$sender,$body);
  275: }
  276: # ============================================================= Check for email
  277: 
  278: sub newmail {
  279:     if ((time-$env{'user.mailcheck.time'})>300) {
  280:         my %what=&Apache::lonnet::get('email_status',['recnewemail']);
  281:         &Apache::lonnet::appenv('user.mailcheck.time'=>time);
  282:         if ($what{'recnewemail'}>0) { return 1; }
  283:     }
  284:     return 0;
  285: }
  286: 
  287: # =============================== Automated message to the author of a resource
  288: 
  289: =pod
  290: 
  291: =item * B<author_res_msg($filename, $message)>: Sends message $message to the owner
  292:     of the resource with the URI $filename.
  293: 
  294: =cut
  295: 
  296: sub author_res_msg {
  297:     my ($filename,$message)=@_;
  298:     unless ($message) { return 'empty'; }
  299:     $filename=&Apache::lonnet::declutter($filename);
  300:     my ($domain,$author,@dummy)=split(/\//,$filename);
  301:     my $homeserver=&Apache::lonnet::homeserver($author,$domain);
  302:     if ($homeserver ne 'no_host') {
  303:        my $id=unpack("%32C*",$message);
  304:        $message .= " <p>This error occurred on machine ".
  305: 	   $Apache::lonnet::perlvar{'lonHostID'}."</p>";
  306:        my $msgid;
  307:        ($msgid,$message)=&packagemsg($filename,$message);
  308:        return &Apache::lonnet::reply('put:'.$domain.':'.$author.
  309:          ':nohist_res_msgs:'.
  310:           &escape($filename.'_'.$id).'='.
  311:           &escape($message),$homeserver);
  312:     }
  313:     return 'no_host';
  314: }
  315: 
  316: # =========================================== Retrieve author resource messages
  317: 
  318: sub retrieve_author_res_msg {
  319:     my $url=shift;
  320:     $url=&Apache::lonnet::declutter($url);
  321:     my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
  322:     my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author);
  323:     my $msgs='';
  324:     foreach (keys %errormsgs) {
  325: 	if ($_=~/^\Q$url\E\_\d+$/) {
  326: 	    my %content=&unpackagemsg($errormsgs{$_});
  327: 	    $msgs.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'.
  328: 		$content{'time'}.'</b>: '.$content{'message'}.
  329: 		'<br /></p>';
  330: 	}
  331:     } 
  332:     return $msgs;     
  333: }
  334: 
  335: 
  336: # =============================== Delete all author messages related to one URL
  337: 
  338: sub del_url_author_res_msg {
  339:     my $url=shift;
  340:     $url=&Apache::lonnet::declutter($url);
  341:     my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
  342:     my @delmsgs=();
  343:     foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
  344: 	if ($_=~/^\Q$url\E\_\d+$/) {
  345: 	    push (@delmsgs,$_);
  346: 	}
  347:     }
  348:     return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
  349: }
  350: # =================================== Clear out all author messages in URL path
  351: 
  352: sub clear_author_res_msg {
  353:     my $url=shift;
  354:     $url=&Apache::lonnet::declutter($url);
  355:     my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
  356:     my @delmsgs=();
  357:     foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
  358: 	if ($_=~/^\Q$url\E/) {
  359: 	    push (@delmsgs,$_);
  360: 	}
  361:     }
  362:     return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
  363: }
  364: # ================= Return hash with URLs for which there is a resource message
  365: 
  366: sub all_url_author_res_msg {
  367:     my ($author,$domain)=@_;
  368:     my %returnhash=();
  369:     foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
  370: 	$_=~/^(.+)\_\d+/;
  371: 	$returnhash{$1}=1;
  372:     }
  373:     return %returnhash;
  374: }
  375: 
  376: # ====================================== Add a comment to the User Notes screen
  377: 
  378: sub store_instructor_comment {
  379:     my ($msg,$uname,$udom) = @_;
  380:     my $cid  = $env{'request.course.id'};
  381:     my $cnum = $env{'course.'.$cid.'.num'};
  382:     my $cdom = $env{'course.'.$cid.'.domain'};
  383:     my $subject= &mt('Record').' ['.$uname.':'.$udom.']';
  384:     my $result = &user_normal_msg_raw($cnum,$cdom,$subject,$msg);
  385:     return $result;
  386: }
  387: 
  388: # ================================================== Critical message to a user
  389: 
  390: sub user_crit_msg_raw {
  391:     my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_;
  392: # Check if allowed missing
  393:     my ($status,$packed_message);
  394:     my $msgid='undefined';
  395:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
  396:     my $text=$message;
  397:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
  398:     if ($homeserver ne 'no_host') {
  399:        ($msgid,$packed_message)=&packagemsg($subject,$message);
  400:        if ($sendback) { $packed_message.='<sendback>true</sendback>'; }
  401:        $status=&Apache::lonnet::critical(
  402:            'put:'.$domain.':'.$user.':critical:'.
  403:            &escape($msgid).'='.
  404:            &escape($packed_message),$homeserver);
  405:         if (defined($sentmessage)) {
  406:             $$sentmessage = $packed_message;
  407:         }
  408:         (undef,my $packed_message_no_citation) =
  409:             &packagemsg($subject,$message,undef,undef,undef,$user,$domain,
  410:                         $msgid);
  411:         $status .= &store_sent_mail($msgid,$packed_message_no_citation);
  412:     } else {
  413:        $status='no_host';
  414:     }
  415: 
  416: # Notifications
  417:     my %userenv = &Apache::loncommon::getemails($user,$domain);
  418:     if ($userenv{'critnotification'}) {
  419:       &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1,
  420: 			$text);
  421:     }
  422:     if ($toperm && $userenv{'permanentemail'}) {
  423:       &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1,
  424: 			$text);
  425:     }
  426: # Log this
  427:     &Apache::lonnet::logthis(
  428:       'Sending critical email '.$msgid.
  429:       ', log status: '.
  430:       &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
  431:                          $env{'user.home'},
  432:       'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
  433:       .$status));
  434:     return $status;
  435: }
  436: 
  437: # New routine that respects "forward" and calls old routine
  438: 
  439: =pod
  440: 
  441: =item * B<user_crit_msg($user, $domain, $subject, $message, $sendback)>: Sends
  442:     a critical message $message to the $user at $domain. If $sendback is true,
  443:     a reciept will be sent to the current user when $user recieves the message.
  444: 
  445:     Additionally it will check if the user has a Forwarding address
  446:     set, and send the message to that address instead
  447: 
  448:     returns 
  449:       - in array context a list of results for each message that was sent
  450:       - in scalar context a space seperated list of results for each 
  451:            message sent
  452: 
  453: =cut
  454: 
  455: sub user_crit_msg {
  456:     my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_;
  457:     my @status;
  458:     my %userenv = &Apache::lonnet::get('environment',['msgforward'],
  459:                                        $domain,$user);
  460:     my $msgforward=$userenv{'msgforward'};
  461:     if ($msgforward) {
  462:        foreach my $addr (split(/\,/,$msgforward)) {
  463: 	 my ($forwuser,$forwdomain)=split(/\:/,$addr);
  464:          push(@status,
  465: 	      &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message,
  466: 				 $sendback,$toperm,$sentmessage));
  467:        }
  468:     } else { 
  469: 	push(@status,
  470: 	     &user_crit_msg_raw($user,$domain,$subject,$message,$sendback,
  471: 				$toperm,$sentmessage));
  472:     }
  473:     if (wantarray) {
  474: 	return @status;
  475:     }
  476:     return join(' ',@status);
  477: }
  478: 
  479: # =================================================== Critical message received
  480: 
  481: sub user_crit_received {
  482:     my $msgid=shift;
  483:     my %message=&Apache::lonnet::get('critical',[$msgid]);
  484:     my %contents=&unpackagemsg($message{$msgid},1);
  485:     my $status='rec: '.($contents{'sendback'}?
  486:      &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
  487:                      &mt('Receipt').': '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.', '.$contents{'subject'},
  488:                      &mt('User').' '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.
  489:                      ' acknowledged receipt of message'."\n".'   "'.
  490:                      $contents{'subject'}.'"'."\n".&mt('dated').' '.
  491:                      $contents{'time'}.".\n"
  492:                      ):'no msg req');
  493:     $status.=' trans: '.
  494:      &Apache::lonnet::put(
  495:      'nohist_email',{$contents{'msgid'} => $message{$msgid}});
  496:     $status.=' del: '.
  497:      &Apache::lonnet::del('critical',[$contents{'msgid'}]);
  498:     &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
  499:                          $env{'user.home'},'Received critical message '.
  500:                          $contents{'msgid'}.
  501:                          ', '.$status);
  502:     return $status;
  503: }
  504: 
  505: # ======================================================== Normal communication
  506: 
  507: sub user_normal_msg_raw {
  508:     my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
  509:         $toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle,
  510:         $error)=@_;
  511: # Check if allowed missing
  512:     my ($status,$packed_message);
  513:     my $msgid='undefined';
  514:     my $text=$message;
  515:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
  516:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
  517:     if ($homeserver ne 'no_host') {
  518:        ($msgid,$packed_message)=
  519: 	                 &packagemsg($subject,$message,$citation,$baseurl,
  520:                                      $attachmenturl,$user,$domain,$currid,
  521:                                      undef,$crsmsgid,$symb,$error);
  522: 
  523: # Store in user folder
  524:        $status=&Apache::lonnet::critical(
  525:            'put:'.$domain.':'.$user.':nohist_email:'.
  526:            &escape($msgid).'='.
  527:            &escape($packed_message),$homeserver);
  528: # Save new message received time
  529:        &Apache::lonnet::put
  530:                          ('email_status',{'recnewemail'=>time},$domain,$user);
  531: # Into sent-mail folder unless a broadcast message or critical message
  532:        unless (($env{'request.course.id'}) && 
  533:                (($env{'form.sendmode'} eq 'group')  || 
  534:                (($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&
  535:                (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
  536: 		|| &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
  537: 					    '/'.$env{'request.course.sec'})))) {
  538:            (undef,my $packed_message_no_citation) =
  539:                &packagemsg($subject,$message,undef,$baseurl,$attachmenturl,
  540:                            $user,$domain,$currid,undef,$crsmsgid,$symb,$error);
  541:            $status .= &store_sent_mail($msgid,$packed_message_no_citation);
  542:        }
  543:     } else {
  544:        $status='no_host';
  545:     }
  546:     if (defined($newid)) {
  547:         $$newid = $msgid;
  548:     }
  549:     if (defined($sentmessage)) {
  550:         $$sentmessage = $packed_message;
  551:     }
  552: 
  553: # Notifications
  554:     my %userenv = &Apache::lonnet::get('environment',['notification',
  555:                                                       'permanentemail'],
  556:                                        $domain,$user);
  557:     if ($userenv{'notification'}) {
  558: 	&sendnotification($userenv{'notification'},$user,$domain,$subject,0,
  559: 			  $text);
  560:     }
  561:     if ($toperm && $userenv{'permanentemail'}) {
  562: 	&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0,
  563: 			  $text);
  564:     }
  565:     &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
  566:                          $env{'user.home'},
  567:       'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
  568:     return $status;
  569: }
  570: 
  571: # New routine that respects "forward" and calls old routine
  572: 
  573: =pod
  574: 
  575: =item * B<user_normal_msg($user, $domain, $subject, $message, $citation,
  576:        $baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle, $error)>:
  577:  Sends a message to the  $user at $domain, with subject $subject and message $message.
  578: 
  579: =cut
  580: 
  581: sub user_normal_msg {
  582:     my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
  583: 	$toperm,$sentmessage,$symb,$restitle,$error)=@_;
  584:     my $status='';
  585:     my %userenv = &Apache::lonnet::get('environment',['msgforward'],
  586:                                        $domain,$user);
  587:     my $msgforward=$userenv{'msgforward'};
  588:     if ($msgforward) {
  589:         foreach (split(/\,/,$msgforward)) {
  590: 	    my ($forwuser,$forwdomain)=split(/\:/,$_);
  591: 	    $status.=
  592: 	        &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,
  593: 				     $citation,$baseurl,$attachmenturl,$toperm,
  594: 				     undef,undef,$sentmessage,undef,$symb,$restitle,$error).' ';
  595:         }
  596:     } else {
  597: 	$status=&user_normal_msg_raw($user,$domain,$subject,$message,
  598: 				     $citation,$baseurl,$attachmenturl,$toperm,
  599: 				     undef,undef,$sentmessage,undef,$symb,$restitle,$error);
  600:     }
  601:     return $status;
  602: }
  603: 
  604: sub store_sent_mail {
  605:     my ($msgid,$message) = @_;
  606:     my $status =' '.&Apache::lonnet::critical(
  607:                'put:'.$env{'user.domain'}.':'.$env{'user.name'}.
  608:                                           ':nohist_email_sent:'.
  609:                &escape($msgid).'='.
  610:                &escape($message),$env{'user.home'});
  611:     return $status;
  612: }
  613: 
  614: # =============================================================== Folder suffix
  615: 
  616: sub foldersuffix {
  617:     my $folder=shift;
  618:     unless ($folder) { return ''; }
  619:     my $suffix;
  620:     my %folderhash = &get_user_folders($folder);
  621:     if (ref($folderhash{$folder}) eq 'HASH') {
  622:         $suffix = '_'.&escape($folderhash{$folder}{'id'});
  623:     } else {
  624:         $suffix = '_'.&escape($folder);
  625:     }
  626:     return $suffix;
  627: }
  628: 
  629: # ========================================================= User-defined folders 
  630: 
  631: sub get_user_folders {
  632:     my ($folder) = @_;
  633:     my %userfolders = 
  634:           &Apache::lonnet::dump('email_folders',undef,undef,$folder);
  635:     my $lock = "\0".'lock_counter'; # locks db while counter incremented
  636:     my $counter = "\0".'idcount';   # used in suffix for email db files
  637:     if (defined($userfolders{$lock})) {
  638:         delete($userfolders{$lock});
  639:     }
  640:     if (defined($userfolders{$counter})) {
  641:         delete($userfolders{$counter});
  642:     }
  643:     return %userfolders;
  644: }
  645: 
  646: 1;
  647: __END__
  648: