Annotation of loncom/interface/lonmsg.pm, revision 1.189

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>