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

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

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