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

1.1       www         1: # The LearningOnline Network with CAPA
1.26      albertel    2: # Routines for messaging
                      3: #
1.251   ! raeburn     4: # $Id: lonmsg.pm,v 1.250 2024/02/08 01:46:23 raeburn 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: 
1.199     raeburn    31: =pod
                     32: 
                     33: =head1 NAME
                     34: 
                     35: Apache::lonmsg: supports internal messaging
                     36: 
                     37: =head1 SYNOPSIS
                     38: 
                     39: lonmsg provides routines for sending messages.
                     40: 
                     41: Right now, this document will cover just how to send a message, since
                     42: it is likely you will not need to programmatically read messages,
                     43: since lonmsg already implements that functionality.
                     44: 
                     45: The routines used to package messages and unpackage messages are not
                     46: only used by lonmsg when creating/extracting messages for LON-CAPA's
                     47: internal messaging system, but also by lonnotify.pm which is available
                     48: for use by Domain Coordinators to broadcast standard e-mail to specified
                     49: users in their domain.  The XML packaging used in the two cases is very
                     50: similar.  The differences are the use of <recuser>$uname</recuser> and
                     51: <recdomain>$udom</recdomain> in stored internal messages, compared
                     52: with <recipient username="$uname:$udom">$email</recipient> in stored
                     53: Domain Coordinator e-mail for the storage of information about
                     54: recipients of the message/e-mail.
                     55: 
1.215     jms        56: =head1 SUBROUTINES
1.199     raeburn    57: 
1.215     jms        58: =over
                     59: 
                     60: =pod
                     61: 
                     62: =item packagemsg()
                     63: 
                     64: Package
                     65: 
                     66: =item get_course_context()
                     67: 
                     68: =item unpackagemsg()
                     69: 
                     70: Unpack message into a hash
                     71: 
                     72: =item buildmsgid()
                     73: 
                     74: Get info out of msgid
                     75: 
                     76: =item unpackmsgid()
                     77: 
                     78: =item sendemail()
                     79: 
                     80: =item sendnotification()
                     81: 
                     82: Send notification emails
                     83: 
                     84: =item newmail()
                     85: 
                     86: Check for email
                     87: 
                     88: =item author_res_msg()
                     89: 
                     90: Automated message to the author of a resource
                     91: 
                     92: =item * B<author_res_msg($filename, $message)>: Sends message $message to the owner
                     93:     of the resource with the URI $filename.
                     94: 
                     95: =item retrieve_author_res_msg()
                     96: 
                     97: Retrieve author resource messages
                     98: 
                     99: =item del_url_author_res_msg()
                    100: 
                    101: Delete all author messages related to one URL
                    102: 
                    103: =item clear_author_res_msg()
                    104: 
                    105: Clear out all author messages in URL path
                    106: 
                    107: =item all_url_author_res_msg()
                    108: 
                    109: Return hash with URLs for which there is a resource message
                    110: 
                    111: =item store_instructor_comment()
                    112: 
                    113: Add a comment to the User Notes screen
                    114: 
                    115: =item user_crit_msg_raw()
                    116: 
                    117: Critical message to a user
                    118: 
                    119: =item user_crit_msg()
                    120: 
                    121: New routine that respects "forward" and calls old routine
                    122: 
1.248     raeburn   123: =item * B<user_crit_msg($user, $domain, $subject, $message, $sendback, $toperm, $sentmessage, $nosentstore, $recipid, $attachmenturl, $permresults, $senthide)>: 
1.215     jms       124:     Sends a critical message $message to the $user at $domain.  If $sendback
                    125:     is true,  a receipt will be sent to the current user when $user receives 
                    126:     the message.
                    127: 
                    128:     Additionally it will check if the user has a Forwarding address
                    129:     set, and send the message to that address instead
                    130: 
                    131:     returns 
                    132:       - in array context a list of results for each message that was sent
                    133:       - in scalar context a space seperated list of results for each 
                    134:            message sent
                    135: 
                    136: 
                    137: =item user_crit_received()
                    138: 
                    139: Critical message received
                    140: 
                    141: =item user_normal_msg_raw()
                    142: 
                    143: Normal communication
                    144: 
                    145: =item user_normal_msg()
                    146: 
                    147: New routine that respects "forward" and calls old routine
                    148: 
                    149: =item * B<user_normal_msg($user, $domain, $subject, $message, $citation,
                    150:        $baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle,
1.248     raeburn   151:        $error,$nosentstore,$recipid,$permresults,$senthide)>:
1.215     jms       152:  Sends a message to the  $user at $domain, with subject $subject and message $message.
                    153: 
                    154:     Additionally it will check if the user has a Forwarding address
                    155:     set, and send the message to that address instead
                    156: 
                    157:     returns
                    158:       - in array context a list of results for each message that was sent
                    159:       - in scalar context a space seperated list of results for each
                    160:            message sent
                    161: 
                    162: =item store_sent_mail()
                    163: 
                    164: =item store_recipients()
                    165: 
                    166: =item foldersuffix()
                    167: 
                    168: =item get_user_folders()
                    169: 
                    170: User-defined folders 
                    171: 
                    172: =item secapply()
                    173: 
                    174: =item B<decide_receiver($feedurl,$author,$question,$course,$policy,$defaultflag)>:
                    175: 
                    176: Arguments
                    177:   $feedurl - /res/ url of resource (only need if $author is true)
                    178:   $author,$question,$course,$policy - all true/false parameters
                    179:     if true will attempt to find the addresses of user that should receive
                    180:     this type of feedback (author - feedback to author of resource $feedurl,
                    181:     $question 'Resource Content Questions', $course 'Course Content Question',
                    182:     $policy 'Course Policy')
                    183:     (Additionally it also checks $env for whether the corresponding form.<name>
                    184:     element exists, for ease of use in a html response context)
                    185:    
                    186:   $defaultflag - (internal should be left blank) if true gather addresses 
                    187:                  that aren't for a section even if I have a section
                    188:                  (used for reccursion internally, first we look for
                    189:                  addresses for our specific section then we recurse
                    190:                  and look for non section addresses)
                    191: 
                    192: Returns
                    193:   $typestyle - string of html text, describing what addresses were found
                    194:   %to - a hash, which keys are addresses of users to send messages to
                    195:         the keys will look like   name:domain
                    196: 
                    197: =back
1.199     raeburn   198: 
                    199: =cut
                    200: 
1.1       www       201: use strict;
1.140     albertel  202: use Apache::lonnet;
1.242     musolffc  203: use Apache::loncommon;
1.47      albertel  204: use HTML::TokeParser();
1.180     albertel  205: use Apache::lonlocal;
1.226     raeburn   206: use HTML::Entities;
                    207: use Encode;
1.187     albertel  208: use LONCAPA qw(:DEFAULT :match);
1.180     albertel  209: 
                    210: {
                    211:     my $uniq;
                    212:     sub get_uniq {
                    213: 	$uniq++;
                    214: 	return $uniq;
                    215:     }
                    216: }
1.65      www       217: 
1.215     jms       218: 
1.1       www       219: 
1.3       www       220: sub packagemsg {
1.248     raeburn   221:     my ($subject,$message,$citation,$baseurl,$attachmenturl,$recuser,$recdomain,
                    222: 	$msgid,$type,$crsmsgid,$symb,$error,$recipid,$senthide,$origmsgid)=@_;
1.96      albertel  223:     $message =&HTML::Entities::encode($message,'<>&"');
                    224:     $citation=&HTML::Entities::encode($citation,'<>&"');
                    225:     $subject =&HTML::Entities::encode($subject,'<>&"');
1.49      albertel  226:     #remove machine specification
1.218     raeburn   227:     $baseurl =~ s|^https?://[^/]+/|/|;
1.96      albertel  228:     $baseurl =&HTML::Entities::encode($baseurl,'<>&"');
1.51      www       229:     #remove machine specification
1.218     raeburn   230:     $attachmenturl =~ s|^https?://[^/]+/|/|;
1.96      albertel  231:     $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
1.248     raeburn   232:     if ($senthide) {
                    233:         foreach my $item ($subject,$message) {
                    234:             if ($item ne '') {
                    235:                 $item = 'Not shown due to IP block';
                    236:             }
                    237:         }
                    238:         if ($attachmenturl ne '') {
                    239:             $attachmenturl = '';
                    240:         }
                    241:         if ($citation ne '') {
                    242:             $citation = '';
                    243:         }
                    244:         if ($msgid ne '') {
                    245:             $msgid = '';
                    246:         }
                    247:     }
1.201     raeburn   248:     my $course_context = &get_course_context();
1.2       www       249:     my $now=time;
1.246     raeburn   250:     my $ip = &Apache::lonnet::get_requestor_ip();
1.180     albertel  251:     my $msgcount = &get_uniq();
1.156     raeburn   252:     unless(defined($msgid)) {
1.159     raeburn   253:         $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'},
1.191     raeburn   254:                            $msgcount,$course_context,$symb,$error,$$);
1.156     raeburn   255:     }
1.174     raeburn   256:     my $result = '<sendername>'.$env{'user.name'}.'</sendername>'.
1.140     albertel  257:            '<senderdomain>'.$env{'user.domain'}.'</senderdomain>'.
1.1       www       258:            '<subject>'.$subject.'</subject>'.
1.174     raeburn   259:            '<time>'.&Apache::lonlocal::locallocaltime($now).'</time>';
                    260:     if (defined($crsmsgid)) {
                    261:         $result.= '<courseid>'.$course_context.'</courseid>'.
                    262:                   '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'.
                    263:                   '<msgid>'.$msgid.'</msgid>'.
                    264:                   '<coursemsgid>'.$crsmsgid.'</coursemsgid>'.
                    265:                   '<message>'.$message.'</message>';
                    266:         return ($msgid,$result);
                    267:     }
                    268:     $result .= '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
1.1       www       269:            '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
1.246     raeburn   270: 	   '<client>'.$ip.'</client>'.
1.140     albertel  271: 	   '<browsertype>'.$env{'browser.type'}.'</browsertype>'.
                    272: 	   '<browseros>'.$env{'browser.os'}.'</browseros>'.
                    273: 	   '<browserversion>'.$env{'browser.version'}.'</browserversion>'.
                    274:            '<browsermathml>'.$env{'browser.mathml'}.'</browsermathml>'.
1.1       www       275: 	   '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
1.158     raeburn   276: 	   '<courseid>'.$course_context.'</courseid>'.
1.140     albertel  277: 	   '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'.
                    278: 	   '<role>'.$env{'request.role'}.'</role>'.
                    279: 	   '<resource>'.$env{'request.filename'}.'</resource>'.
1.156     raeburn   280:            '<msgid>'.$msgid.'</msgid>';
1.214     raeburn   281:     if (defined($env{'form.group'})) {
                    282:         $result .= '<group>'.$env{'form.group'}.'</group>';
                    283:     }
1.156     raeburn   284:     if (ref($recuser) eq 'ARRAY') {
                    285:         for (my $i=0; $i<@{$recuser}; $i++) {
1.162     raeburn   286:             if ($type eq 'dcmail') {
                    287:                 my ($username,$email) = split(/:/,$$recuser[$i]);
1.184     www       288:                 $username = &unescape($username);
                    289:                 $email = &unescape($email);
1.162     raeburn   290:                 $username = &HTML::Entities::encode($username,'<>&"');
                    291:                 $email = &HTML::Entities::encode($email,'<>&"');
                    292:                 $result .= '<recipient username="'.$username.'">'.
                    293:                                             $email.'</recipient>';
                    294:             } else {
                    295:                 $result .= '<recuser>'.$$recuser[$i].'</recuser>'.
                    296:                            '<recdomain>'.$$recdomain[$i].'</recdomain>';
                    297:             }
1.156     raeburn   298:         }
                    299:     } else {
                    300:         $result .= '<recuser>'.$recuser.'</recuser>'.
                    301:                    '<recdomain>'.$recdomain.'</recdomain>';
                    302:     }
                    303:     $result .= '<message>'.$message.'</message>';
1.49      albertel  304:     if (defined($citation)) {
                    305: 	$result.='<citation>'.$citation.'</citation>';
                    306:     }
                    307:     if (defined($baseurl)) {
                    308: 	$result.= '<baseurl>'.$baseurl.'</baseurl>';
                    309:     }
1.51      www       310:     if (defined($attachmenturl)) {
1.52      www       311: 	$result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>';
1.51      www       312:     }
1.191     raeburn   313:     if (defined($symb)) {
                    314:         $result.= '<symb>'.$symb.'</symb>';
1.201     raeburn   315:         if ($course_context ne '') {
1.191     raeburn   316:             if ($course_context eq $env{'request.course.id'}) {
                    317:                 my $resource_title = &Apache::lonnet::gettitle($symb);
                    318:                 if (defined($resource_title)) {
                    319:                     $result .= '<resource_title>'.$resource_title.'</resource_title>';
                    320:                 }
                    321:             }
                    322:         }
                    323:     }
1.202     raeburn   324:     if (defined($recipid)) {
                    325:         $result.= '<recipid>'.$recipid.'</recipid>';
                    326:     }
1.204     raeburn   327:     if ($env{'form.can_reply'} eq 'N') {
                    328:         $result .= '<noreplies>1</noreplies>';
                    329:     }
                    330:     if ($env{'form.reply_to_addr'}) {
                    331:         my ($replytoname,$replytodom) = split(/:/,$env{'form.reply_to_addr'});
                    332:         if (!($replytoname eq $env{'user.name'} && $replytodom eq $env{'user.domain'})) {
                    333:             if (&Apache::lonnet::homeserver($replytoname,$replytodom) ne 'no_host') {
                    334:                 $result .= '<replytoaddr>'.$env{'form.reply_to_addr'}.'</replytoaddr>';
                    335:             }
                    336:         }
                    337:     }
1.248     raeburn   338:     if ($senthide) {
                    339:         $result .= '<senthide>$origmsgid</senthide>';
                    340:     }
1.191     raeburn   341:     return ($msgid,$result);
1.1       www       342: }
                    343: 
1.201     raeburn   344: sub get_course_context {
                    345:     my $course_context;
1.212     raeburn   346:     my $msgkey;
1.201     raeburn   347:     if (defined($env{'form.replyid'})) {
1.212     raeburn   348:         $msgkey = $env{'form.replyid'};
                    349:     } elsif (defined($env{'form.forwid'})) {
                    350:         $msgkey = $env{'form.forwid'}
                    351:     } elsif (defined($env{'form.multiforwid'})) {
                    352:         $msgkey = $env{'form.multiforwid'};
                    353:     }
                    354:     if ($msgkey ne '') {
1.201     raeburn   355:         my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)=
1.212     raeburn   356:                    split(/\:/,&unescape($msgkey));
1.201     raeburn   357:         $course_context = $origcid;
                    358:     }
                    359:     foreach my $key (keys(%env)) {
                    360:         if ($key=~/^form\.(rep)?rec\_(.*)$/) {
                    361:             my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid) =
                    362:                                     split(/\:/,&unescape($2));
                    363:             $course_context = $origcid;
                    364:             last;
                    365:         }
                    366:     }
                    367:     if ($course_context eq '') {
                    368:         $course_context = $env{'request.course.id'};
                    369:     }
                    370:     return $course_context;
                    371: }
                    372: 
1.2       www       373: 
1.3       www       374: sub unpackagemsg {
1.212     raeburn   375:     my ($message,$notoken,$noattachmentlink)=@_;
1.2       www       376:     my %content=();
                    377:     my $parser=HTML::TokeParser->new(\$message);
                    378:     my $token;
                    379:     while ($token=$parser->get_token) {
                    380:        if ($token->[0] eq 'S') {
                    381: 	   my $entry=$token->[1];
                    382:            my $value=$parser->get_text('/'.$entry);
1.156     raeburn   383:            if (($entry eq 'recuser') || ($entry eq 'recdomain')) {
                    384:                push(@{$content{$entry}},$value);
1.162     raeburn   385:            } elsif ($entry eq 'recipient') {
                    386:                my $username = $token->[2]{'username'};
                    387:                $username = &HTML::Entities::decode($username,'<>&"');
                    388:                $content{$entry}{$username} = $value;
1.156     raeburn   389:            } else {
                    390:                $content{$entry}=$value;
                    391:            }
1.2       www       392:        }
                    393:     }
1.168     albertel  394:     if (!exists($content{'recuser'})) { $content{'recuser'} = []; }
1.212     raeburn   395:     if (($content{'attachmenturl'}) && (!$noattachmentlink)) {
1.100     albertel  396:        my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);
1.52      www       397:        if ($notoken) {
1.100     albertel  398: 	   $content{'message'}.='<p>'.&mt('Attachment').': <tt>'.$fname.'</tt>';
1.52      www       399:        } else {
1.99      albertel  400: 	   &Apache::lonnet::allowuploaded('/adm/msg',
                    401: 					  $content{'attachmenturl'});
                    402: 	   $content{'message'}.='<p>'.&mt('Attachment').
                    403: 	       ': <a href="'.$content{'attachmenturl'}.'"><tt>'.
1.100     albertel  404: 	       $fname.'</tt></a>';
1.52      www       405:        }
                    406:     }
1.2       www       407:     return %content;
                    408: }
                    409: 
1.6       www       410: 
1.159     raeburn   411: sub buildmsgid {
1.191     raeburn   412:     my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_;
1.184     www       413:     $subject=&escape($subject);
1.192     raeburn   414:     $symb = &escape($symb);
1.184     www       415:     return(&escape($now.':'.$subject.':'.$uname.':'.
1.191     raeburn   416:            $udom.':'.$msgcount.':'.$course_context.':'.$pid.':'.$symb.':'.$error));
1.159     raeburn   417: }
                    418: 
1.6       www       419: sub unpackmsgid {
1.243     raeburn   420:     my ($msgid,$folder,$skipstatus,$status_cache,$onlycid)=@_;
1.184     www       421:     $msgid=&unescape($msgid);
1.167     raeburn   422:     my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid,
1.191     raeburn   423:         $processid,$symb,$error) = split(/\:/,&unescape($msgid));
1.243     raeburn   424:     if (!defined($processid)) { $fromcid = ''; }
                    425:     if (($onlycid) && ($onlycid ne $fromcid)) {
                    426:         return ($sendtime,'',$fromname,$fromdomain,'',$fromcid,'',$error);
                    427:     }
1.184     www       428:     $shortsubj = &unescape($shortsubj);
1.182     albertel  429:     $shortsubj = &HTML::Entities::decode($shortsubj);
1.192     raeburn   430:     $symb = &unescape($symb);
1.164     raeburn   431:     my %status=();
                    432:     unless ($skipstatus) {
1.169     albertel  433: 	if (ref($status_cache)) {
                    434: 	    $status{$msgid} = $status_cache->{$msgid};
                    435: 	} else {
                    436: 	    my $suffix=&foldersuffix($folder);
                    437: 	    %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]);
                    438: 	}
                    439: 	if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
1.164     raeburn   440:         unless ($status{$msgid}) { $status{$msgid}='new'; }
                    441:     }
1.191     raeburn   442:     return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid,$symb,$error);
1.141     raeburn   443: }
1.6       www       444: 
1.53      www       445: 
                    446: sub sendemail {
1.242     musolffc  447:     my ($to,$subject,$body,$to_uname,$to_udom,$user_lh,$attachmenturl)=@_;
1.186     www       448:     my $senderaddress='';
1.220     raeburn   449:     my $replytoaddress='';
1.238     raeburn   450:     my $msgsent;
1.220     raeburn   451:     if ($env{'form.can_reply'} eq 'N') {
                    452:         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                    453:         my $hostname = &Apache::lonnet::hostname($lonhost);
                    454:         $replytoaddress = 'do-not-reply@'.$hostname;
                    455:     } else {
                    456:         my %senderemails;
1.251   ! raeburn   457:         my ($have_sender,$setreplyto);
1.220     raeburn   458:         if ($env{'form.reply_to_addr'}) {
                    459:             my ($replytoname,$replytodom) = split(/:/,$env{'form.reply_to_addr'});
1.250     raeburn   460:             if (($replytoname eq $env{'user.name'} && $replytodom eq $env{'user.domain'})) {
                    461:                 $setreplyto = 1;
                    462:             } else {
1.220     raeburn   463:                 if (&Apache::lonnet::homeserver($replytoname,$replytodom) ne 'no_host') {
                    464:                     %senderemails = 
                    465:                         &Apache::loncommon::getemails($replytoname,$replytodom);
                    466:                     $have_sender = 1;
1.250     raeburn   467:                     $setreplyto = 1;
1.220     raeburn   468:                 }
                    469:             }
                    470:         }
                    471:         if (!$have_sender) {
                    472:             %senderemails=&Apache::loncommon::getemails();
                    473:         }
                    474:         foreach my $type ('permanentemail','critnotification','notification') {
                    475:             if ($senderemails{$type}) {
                    476:                 ($senderaddress) = split(/,/,$senderemails{$type});
1.250     raeburn   477:                 if ($senderaddress) {
                    478:                     if ($setreplyto) {
                    479:                         $replytoaddress = $senderaddress;
                    480:                     }
                    481:                     last;
                    482:                 }
1.220     raeburn   483:             }
                    484:         }
1.186     www       485:     }
1.53      www       486:     $body=
1.217     schafran  487:     "*** ".&mt_user($user_lh,'This is an automatic e-mail generated by the LON-CAPA system.')."\n".
                    488:     "*** ".($senderaddress?&mt_user($user_lh,'You can reply to this e-mail'):&mt_user($user_lh,'Please do not reply to this address.')."\n*** ".
1.220     raeburn   489:     &mt_user($user_lh,'A reply will not be received by the recipient!'))."\n\n".$body;
1.225     jms       490:     
1.242     musolffc  491:     $attachmenturl = &Apache::lonnet::filelocation("",$attachmenturl);
                    492:     my $filesize = (stat($attachmenturl))[7];
                    493:     if ($filesize > 1048576) {
                    494:         # Don't send if it exceeds 1 MB.
                    495:         print '<p><span class="LC_error">' 
                    496:             .&mt('Email not sent.  Attachment exceeds permitted length.')
                    497:             .'</span><br /></p>';
                    498:     } else {
                    499:         # Otherwise build and send the email
                    500:         $subject = '[LON-CAPA] '.$subject;
1.245     raeburn   501:         &Apache::loncommon::mime_email($senderaddress,$replytoaddress,$to,
                    502:                                        $subject,$body,'','',$attachmenturl,'','');
1.238     raeburn   503:         $msgsent = 1;
1.68      www       504:     }
1.238     raeburn   505:     return $msgsent;
1.53      www       506: }
                    507: 
                    508: # ==================================================== Send notification emails
                    509: 
                    510: sub sendnotification {
1.242     musolffc  511:     my ($to,$touname,$toudom,$subj,$crit,$text,$msgid,$attachmenturl)=@_;
1.140     albertel  512:     my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'};
1.131     www       513:     unless ($sender=~/\w/) { 
1.208     raeburn   514: 	$sender=$env{'user.name'}.':'.$env{'user.domain'};
1.131     www       515:     }
1.53      www       516:     my $critical=($crit?' critical':'');
1.238     raeburn   517:     my $numsent = 0;
1.208     raeburn   518: 
1.131     www       519:     $text=~s/\&lt\;/\</gs;
                    520:     $text=~s/\&gt\;/\>/gs;
1.249     raeburn   521:     my $touhome = &Apache::lonnet::homeserver($touname,$toudom);
                    522:     my $url = &Apache::lonnet::url_prefix('',$toudom,$touhome,'email').
1.226     raeburn   523:               '/adm/email?username='.$touname.'&domain='.$toudom.
                    524:               '&display='.&escape($msgid);
1.194     raeburn   525:     my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid,
                    526:         $symb,$error) = &Apache::lonmsg::unpackmsgid($msgid);
1.208     raeburn   527:     my ($coursetext,$body,$bodybegin,$bodysubj,$bodyend);
1.222     raeburn   528:     my $user_lh = &Apache::loncommon::user_lang($touname,$toudom,$fromcid);
1.194     raeburn   529:     if ($fromcid ne '') {
1.213     raeburn   530:         $coursetext = "\n".&mt_user($user_lh,'Course').': ';
1.194     raeburn   531:         if ($env{'course.'.$fromcid.'.description'} ne '') {
                    532:             $coursetext .= $env{'course.'.$fromcid.'.description'};
                    533:         } else {
                    534:             my %coursehash = &Apache::lonnet::coursedescription($fromcid,);
                    535:             if ($coursehash{'description'} ne '') {
                    536:                 $coursetext .= $coursehash{'description'};
                    537:             }
                    538:         }
                    539:         $coursetext .= "\n\n";
                    540:     }
1.206     raeburn   541:     my @recipients = split(/,/,$to);
1.208     raeburn   542:     $bodybegin = $coursetext. 
1.213     raeburn   543:                &mt_user($user_lh,
                    544:                          'You received a'.$critical.' message from [_1] in LON-CAPA.',$sender).' ';
                    545:     $bodysubj = &mt_user($user_lh,'The subject is 
1.53      www       546: 
1.195     raeburn   547:  [_1]
1.53      www       548: 
1.195     raeburn   549: ',$subj)."\n".
1.213     raeburn   550: '=== '.&mt_user($user_lh,'Excerpt')." ============================================================
1.206     raeburn   551: ";
                    552:     $bodyend = "
1.131     www       553: ========================================================================
                    554: 
1.213     raeburn   555: ".&mt_user($user_lh,'Use 
1.53      www       556: 
1.195     raeburn   557:  [_1]
1.53      www       558: 
1.195     raeburn   559: to access the full message.',$url);
1.206     raeburn   560:     my %userenv = &Apache::lonnet::get('environment',['notifywithhtml'],$toudom,$touname);
1.235     bisitz    561:     my $subject = &mt_user($user_lh,"'New'$critical message from [_1]",$sender);
1.232     raeburn   562:     unless ($subj eq '') {
                    563:         $subject = $subj;
                    564:     }
1.208     raeburn   565:  
1.247     raeburn   566:     my ($blocked,$blocktext,$clientip);
                    567:     $clientip = &Apache::lonnet::get_requestor_ip();
1.208     raeburn   568:     if (!$crit) {
                    569:         my %setters;
1.247     raeburn   570:         my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = 
                    571:             &Apache::loncommon::blockcheck(\%setters,'com',$clientip,$touname,$toudom);
1.208     raeburn   572:         if ($startblock && $endblock) {
                    573:             $blocked = 1;
1.209     albertel  574:             my $showstart = &Apache::lonlocal::locallocaltime($startblock);
                    575:             my $showend = &Apache::lonlocal::locallocaltime($endblock);
1.213     raeburn   576:             $blocktext = &mt_user($user_lh,'LON-CAPA messages sent to you between [_1] and [_2] will be inaccessible until the end of this time period, because you are a student in a course with an active communications block.',$showstart,$showend);
1.247     raeburn   577:         } elsif ($by_ip) {
                    578:             $blocked = 1;
                    579:             $blocktext = &mt_user($user_lh,'LON-CAPA messages sent to you will be inaccessible from your IP address [_1], because communication is being blocked for certain IP address(es).',$clientip);
1.208     raeburn   580:         }
                    581:     }
1.206     raeburn   582:     if ($userenv{'notifywithhtml'} ne '') {
                    583:         my @htmlexcerpt = split(/,/,$userenv{'notifywithhtml'});
1.226     raeburn   584:         my $htmlfree = &make_htmlfree($text);
1.206     raeburn   585:         foreach my $addr (@recipients) {
1.208     raeburn   586:             if ($blocked) {
                    587:                 $body = $bodybegin."\n".$blocktext."\n".$bodyend;
                    588:             } else {
1.226     raeburn   589:                 my $sendtext;
1.208     raeburn   590:                 if (!grep/^\Q$addr\E/,@htmlexcerpt) {
1.227     raeburn   591:                     $sendtext = $htmlfree;
1.226     raeburn   592:                 } else {
                    593:                     $sendtext = $text;
1.208     raeburn   594:                 }
                    595:                 $body = $bodybegin.$bodysubj.$sendtext.$bodyend;
1.206     raeburn   596:             }
1.242     musolffc  597:             if (&sendemail($addr,$subject,$body,$touname,$toudom,$user_lh,$attachmenturl)) {
1.238     raeburn   598:                 $numsent ++;
                    599:             }
1.206     raeburn   600:         }
                    601:     } else {
1.208     raeburn   602:         if ($blocked) {
                    603:             $body = $bodybegin."\n".$blocktext."\n".$bodyend;
                    604:         } else {
1.226     raeburn   605:             my $htmlfree = &make_htmlfree($text);
                    606:             $body = $bodybegin.$bodysubj.$htmlfree.$bodyend;
1.208     raeburn   607:         }
1.242     musolffc  608:         if (&sendemail($to,$subject,$body,$touname,$toudom,$user_lh,$attachmenturl)) {
1.238     raeburn   609:             $numsent ++;
                    610:         }
1.206     raeburn   611:     }
1.238     raeburn   612:     return $numsent;
1.53      www       613: }
1.215     jms       614: 
1.226     raeburn   615: sub make_htmlfree {
                    616:     my ($text) = @_;
                    617:     $text =~ s/\<\/*[^\>]+\>//gs;
                    618:     $text = &HTML::Entities::decode($text);
                    619:     $text = &Encode::encode('utf8',$text);
                    620:     return $text;
                    621: }
                    622: 
1.223     kaisler   623: sub mynewmail{
                    624: 	&newmail();
1.231     raeburn   625: 	return $env{'user.mailcheck.lastnewmessagetime'} > $env{'user.mailcheck.lastvisit'};
1.223     kaisler   626: }
                    627: 
1.40      www       628: 
                    629: sub newmail {
1.140     albertel  630:     if ((time-$env{'user.mailcheck.time'})>300) {
1.40      www       631:         my %what=&Apache::lonnet::get('email_status',['recnewemail']);
1.211     raeburn   632:         &Apache::lonnet::appenv({'user.mailcheck.time'=>time});
1.231     raeburn   633: 		&Apache::lonnet::appenv({'user.mailcheck.lastnewmessagetime'=> $what{'recnewemail'}});
1.40      www       634:         if ($what{'recnewemail'}>0) { return 1; }
                    635:     }
                    636:     return 0;
                    637: }
                    638: 
1.1       www       639: 
1.58      bowersj2  640: 
1.1       www       641: sub author_res_msg {
                    642:     my ($filename,$message)=@_;
1.2       www       643:     unless ($message) { return 'empty'; }
1.1       www       644:     $filename=&Apache::lonnet::declutter($filename);
1.72      www       645:     my ($domain,$author,@dummy)=split(/\//,$filename);
1.1       www       646:     my $homeserver=&Apache::lonnet::homeserver($author,$domain);
                    647:     if ($homeserver ne 'no_host') {
                    648:        my $id=unpack("%32C*",$message);
1.181     albertel  649:        $message .= " <p>This error occurred on machine ".
                    650: 	   $Apache::lonnet::perlvar{'lonHostID'}."</p>";
1.2       www       651:        my $msgid;
1.72      www       652:        ($msgid,$message)=&packagemsg($filename,$message);
1.3       www       653:        return &Apache::lonnet::reply('put:'.$domain.':'.$author.
1.72      www       654:          ':nohist_res_msgs:'.
1.184     www       655:           &escape($filename.'_'.$id).'='.
                    656:           &escape($message),$homeserver);
1.1       www       657:     }
1.2       www       658:     return 'no_host';
1.73      www       659: }
                    660: 
1.215     jms       661: 
1.73      www       662: 
                    663: sub retrieve_author_res_msg {
1.75      www       664:     my $url=shift;
1.73      www       665:     $url=&Apache::lonnet::declutter($url);
1.187     albertel  666:     my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
1.76      www       667:     my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author);
1.73      www       668:     my $msgs='';
1.239     raeburn   669:     foreach my $msg (keys(%errormsgs)) {
                    670: 	if ($msg =~ /^\Q$url\E\_\d+$/) {
                    671: 	    my %content=&unpackagemsg($errormsgs{$msg});
1.74      www       672: 	    $msgs.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'.
                    673: 		$content{'time'}.'</b>: '.$content{'message'}.
                    674: 		'<br /></p>';
1.73      www       675: 	}
                    676:     } 
                    677:     return $msgs;     
                    678: }
                    679: 
                    680: 
1.215     jms       681: 
                    682: 
1.73      www       683: 
                    684: sub del_url_author_res_msg {
1.75      www       685:     my $url=shift;
1.73      www       686:     $url=&Apache::lonnet::declutter($url);
1.187     albertel  687:     my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
1.77      www       688:     my @delmsgs=();
1.239     raeburn   689:     foreach my $msg (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
                    690: 	if ($msg =~ /^\Q$url\E\_\d+$/) {
                    691: 	    push (@delmsgs,$msg);
1.77      www       692: 	}
                    693:     }
                    694:     return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
1.73      www       695: }
1.215     jms       696: 
1.73      www       697: 
1.152     www       698: sub clear_author_res_msg {
                    699:     my $url=shift;
                    700:     $url=&Apache::lonnet::declutter($url);
1.187     albertel  701:     my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
1.152     www       702:     my @delmsgs=();
1.239     raeburn   703:     foreach my $msg (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
                    704: 	if ($msg =~ /^\Q$url\E/) {
                    705: 	    push (@delmsgs,$msg);
1.152     www       706: 	}
                    707:     }
                    708:     return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
                    709: }
1.215     jms       710: 
                    711: 
1.73      www       712: 
                    713: sub all_url_author_res_msg {
                    714:     my ($author,$domain)=@_;
1.75      www       715:     my %returnhash=();
1.239     raeburn   716:     foreach my $msg (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
                    717: 	$msg =~ /^(.+)\_\d+/;
1.75      www       718: 	$returnhash{$1}=1;
                    719:     }
                    720:     return %returnhash;
1.1       www       721: }
                    722: 
1.185     albertel  723: 
                    724: sub store_instructor_comment {
                    725:     my ($msg,$uname,$udom) = @_;
                    726:     my $cid  = $env{'request.course.id'};
                    727:     my $cnum = $env{'course.'.$cid.'.num'};
                    728:     my $cdom = $env{'course.'.$cid.'.domain'};
                    729:     my $subject= &mt('Record').' ['.$uname.':'.$udom.']';
                    730:     my $result = &user_normal_msg_raw($cnum,$cdom,$subject,$msg);
1.201     raeburn   731:     if ($result eq 'ok' || $result eq 'con_delayed') {
                    732:         
                    733:     }
1.185     albertel  734:     return $result;
                    735: }
                    736: 
1.1       www       737: 
1.38      www       738: sub user_crit_msg_raw {
1.201     raeburn   739:     my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,
1.248     raeburn   740:         $nosentstore,$recipid,$attachmenturl,$permresults,$senthide)=@_;
1.2       www       741: # Check if allowed missing
1.190     raeburn   742:     my ($status,$packed_message);
1.2       www       743:     my $msgid='undefined';
                    744:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
1.131     www       745:     my $text=$message;
1.2       www       746:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
                    747:     if ($homeserver ne 'no_host') {
1.202     raeburn   748:        ($msgid,$packed_message)=&packagemsg($subject,$message,undef,undef,
1.212     raeburn   749:                                   $attachmenturl,undef,undef,undef,undef,undef,
                    750:                                   undef,undef,$recipid);
1.190     raeburn   751:        if ($sendback) { $packed_message.='<sendback>true</sendback>'; }
1.210     albertel  752:        $status=&Apache::lonnet::cput('critical', {$msgid => $packed_message},
                    753: 				     $domain,$user);
1.159     raeburn   754:         if (defined($sentmessage)) {
1.190     raeburn   755:             $$sentmessage = $packed_message;
1.159     raeburn   756:         }
1.201     raeburn   757:         if (!$nosentstore) {
1.248     raeburn   758:             my ($sentmsgid,$packed_message_no_citation) =
1.212     raeburn   759:             &packagemsg($subject,$message,undef,undef,$attachmenturl,$user,
1.248     raeburn   760:                         $domain,$msgid,undef,undef,undef,undef,undef,$senthide,$msgid);
1.193     raeburn   761:             if ($status eq 'ok' || $status eq 'con_delayed') {
1.248     raeburn   762:                 if ($senthide && $sentmsgid) {
                    763:                     &store_sent_mail($sentmsgid,$packed_message_no_citation);
                    764:                 } else {
                    765:                     &store_sent_mail($msgid,$packed_message_no_citation);
                    766:                 }
1.193     raeburn   767:             }
                    768:         }
1.2       www       769:     } else {
                    770:        $status='no_host';
                    771:     }
1.190     raeburn   772: 
1.53      www       773: # Notifications
1.186     www       774:     my %userenv = &Apache::loncommon::getemails($user,$domain);
1.238     raeburn   775:     my $critnotify = $userenv{'critnotification'};
                    776:     my $permemail = $userenv{'permanentemail'};
                    777:     my $numcrit = 0;
                    778:     my $numperm = 0;
                    779:     my $permlogmsgstatus;
                    780:     if ($critnotify) {
1.242     musolffc  781:         $numcrit = &sendnotification($critnotify,$user,$domain,$subject,1,$text,$msgid,$attachmenturl);
1.238     raeburn   782:     }
                    783:     if ($toperm && $permemail) {
                    784:         if ($critnotify && $numcrit) {
                    785:             if (grep(/^\Q$permemail\E/,split(/,/,$critnotify))) {
                    786:                 $numperm = 1;
                    787:             }
                    788:         }
                    789:         unless ($numperm) {
1.242     musolffc  790:             $numperm = &sendnotification($permemail,$user,$domain,$subject,1,$text,$msgid,$attachmenturl);
1.238     raeburn   791:         }
                    792:     }
                    793:     if ($toperm) {
                    794:         $permlogmsgstatus = '. Perm. email log status '.
                    795:                             &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},$env{'user.home'},
                    796:                                                  "Perm. e-mail count $numperm for $user at $domain");
                    797:         if (ref($permresults) eq 'HASH') {
                    798:             $permresults->{"$user:$domain"} = $numperm;
                    799:         }
1.132     www       800:     }
1.53      www       801: # Log this
1.2       www       802:     &Apache::lonnet::logthis(
1.238     raeburn   803:       'Sending critical '.$msgid.
1.2       www       804:       ', log status: '.
1.140     albertel  805:       &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
                    806:                          $env{'user.home'},
1.238     raeburn   807:       'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status '
                    808:       .$status).$permlogmsgstatus);
1.2       www       809:     return $status;
                    810: }
                    811: 
1.38      www       812: 
1.58      bowersj2  813: 
1.38      www       814: sub user_crit_msg {
1.201     raeburn   815:     my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,
1.248     raeburn   816:         $nosentstore,$recipid,$attachmenturl,$permresults,$senthide)=@_;
1.183     albertel  817:     my @status;
1.38      www       818:     my %userenv = &Apache::lonnet::get('environment',['msgforward'],
                    819:                                        $domain,$user);
                    820:     my $msgforward=$userenv{'msgforward'};
                    821:     if ($msgforward) {
1.183     albertel  822:        foreach my $addr (split(/\,/,$msgforward)) {
                    823: 	 my ($forwuser,$forwdomain)=split(/\:/,$addr);
                    824:          push(@status,
                    825: 	      &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message,
1.202     raeburn   826: 				 $sendback,$toperm,$sentmessage,$nosentstore,
1.248     raeburn   827:                                  $recipid,$attachmenturl,$permresults,$senthide));
1.38      www       828:        }
                    829:     } else { 
1.183     albertel  830: 	push(@status,
                    831: 	     &user_crit_msg_raw($user,$domain,$subject,$message,$sendback,
1.212     raeburn   832: 				$toperm,$sentmessage,$nosentstore,$recipid,
1.248     raeburn   833:                                 $attachmenturl,$permresults,$senthide));
1.38      www       834:     }
1.183     albertel  835:     if (wantarray) {
                    836: 	return @status;
                    837:     }
                    838:     return join(' ',@status);
1.38      www       839: }
                    840: 
1.2       www       841: 
                    842: sub user_crit_received {
1.12      www       843:     my $msgid=shift;
                    844:     my %message=&Apache::lonnet::get('critical',[$msgid]);
1.52      www       845:     my %contents=&unpackagemsg($message{$msgid},1);
1.204     raeburn   846:     my $destname = $contents{'sendername'};
                    847:     my $destdom = $contents{'senderdomain'};
                    848:     if ($contents{'replytoaddr'}) {
                    849:         my ($repname,$repdom) = split(/:/,$contents{'replytoaddr'});
                    850:         if (&Apache::lonnet::homeserver($repname,$repdom) ne 'no_host') {
                    851:             $destname = $repname;
                    852:             $destdom = $repdom;    
                    853:         }
                    854:     }
1.24      www       855:     my $status='rec: '.($contents{'sendback'}?
1.204     raeburn   856:      &user_normal_msg($destname,$destdom,&mt('Receipt').': '.$env{'user.name'}.
                    857:                       ' '.&mt('at').' '.$env{'user.domain'}.', '.
                    858:                       $contents{'subject'},&mt('User').' '.$env{'user.name'}.
                    859:                       ' '.&mt('at').' '.$env{'user.domain'}.
                    860:                       ' acknowledged receipt of message'."\n".'   "'.
                    861:                       $contents{'subject'}.'"'."\n".&mt('dated').' '.
                    862:                       $contents{'time'}.".\n"
                    863:                       ):'no msg req');
1.5       www       864:     $status.=' trans: '.
1.12      www       865:      &Apache::lonnet::put(
                    866:      'nohist_email',{$contents{'msgid'} => $message{$msgid}});
1.5       www       867:     $status.=' del: '.
1.9       albertel  868:      &Apache::lonnet::del('critical',[$contents{'msgid'}]);
1.140     albertel  869:     &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
                    870:                          $env{'user.home'},'Received critical message '.
1.5       www       871:                          $contents{'msgid'}.
                    872:                          ', '.$status);
1.12      www       873:     return $status;
1.2       www       874: }
                    875: 
1.215     jms       876: 
                    877: 
1.2       www       878: 
1.38      www       879: sub user_normal_msg_raw {
1.132     www       880:     my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
1.191     raeburn   881:         $toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle,
1.248     raeburn   882:         $error,$nosentstore,$recipid,$permresults,$senthide)=@_;
1.2       www       883: # Check if allowed missing
1.173     albertel  884:     my ($status,$packed_message);
1.2       www       885:     my $msgid='undefined';
1.131     www       886:     my $text=$message;
1.2       www       887:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
                    888:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
                    889:     if ($homeserver ne 'no_host') {
1.173     albertel  890:        ($msgid,$packed_message)=
                    891: 	                 &packagemsg($subject,$message,$citation,$baseurl,
1.174     raeburn   892:                                      $attachmenturl,$user,$domain,$currid,
1.202     raeburn   893:                                      undef,$crsmsgid,$symb,$error,$recipid);
1.174     raeburn   894: 
1.108     www       895: # Store in user folder
1.210     albertel  896:        $status=
                    897: 	   &Apache::lonnet::cput('nohist_email',{$msgid => $packed_message},
                    898: 				 $domain,$user);
1.108     www       899: # Save new message received time
1.40      www       900:        &Apache::lonnet::put
                    901:                          ('email_status',{'recnewemail'=>time},$domain,$user);
1.201     raeburn   902: # Into sent-mail folder if sent mail storage required
                    903:        if (!$nosentstore) {
1.248     raeburn   904:            my ($sentmsgid,$packed_message_no_citation) =
1.190     raeburn   905:                &packagemsg($subject,$message,undef,$baseurl,$attachmenturl,
1.248     raeburn   906:                            $user,$domain,$currid,undef,$crsmsgid,$symb,$error,
                    907:                            undef,$senthide,$msgid);
1.193     raeburn   908:            if ($status eq 'ok' || $status eq 'con_delayed') {
1.248     raeburn   909:                if ($senthide && $sentmsgid) {
                    910:                    &store_sent_mail($sentmsgid,$packed_message_no_citation);
                    911:                } else {
                    912:                    &store_sent_mail($msgid,$packed_message_no_citation);
                    913:                }
1.193     raeburn   914:            }
1.156     raeburn   915:        }
1.201     raeburn   916:        if (ref($newid) eq 'SCALAR') {
1.196     www       917: 	   $$newid = $msgid;
                    918:        }
1.201     raeburn   919:        if (ref($sentmessage) eq 'SCALAR') {
1.196     www       920: 	   $$sentmessage = $packed_message;
                    921:        }
                    922: # Notifications
1.206     raeburn   923:        my %userenv = &Apache::loncommon::getemails($user,$domain);
1.238     raeburn   924:        my $notify = $userenv{'notification'};
                    925:        my $permemail = $userenv{'permanentemail'};
                    926:        my $numnotify = 0;
                    927:        my $numperm = 0;
                    928:        my $permlogmsgstatus;
                    929:        if ($notify) {
1.242     musolffc  930:            $numnotify = &sendnotification($notify,$user,$domain,$subject,0,$text,$msgid,$attachmenturl);
1.238     raeburn   931:        }
                    932:        if ($toperm && $permemail) {
                    933:            if ($notify && $numnotify) {
                    934:                if (grep(/^\Q$permemail\E/,split(/,/,$notify))) {
                    935:                    $numperm = 1;
                    936:                }
                    937:            }
                    938:            unless ($numperm) {
                    939:                $numperm = &sendnotification($permemail,$user,$domain,$subject,0,
1.242     musolffc  940:                                             $text,$msgid,$attachmenturl);
1.238     raeburn   941:            }
1.196     www       942:        }
1.238     raeburn   943:        if ($toperm) {
                    944:            $permlogmsgstatus = '. Perm. email log status '.
                    945:                          &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},$env{'user.home'},
                    946:                                               "Perm. e-mail count $numperm for $user at $domain");
                    947:            if (ref($permresults) eq 'HASH') {
                    948:                $permresults->{"$user:$domain"} = $numperm;
1.214     raeburn   949:            }
1.196     www       950:        }
                    951:        &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
                    952: 			    $env{'user.home'},
1.238     raeburn   953: 			    'Sending '.$msgid.' to '.$user.' at '.$domain.' with status '.$status.
                    954:                             $permlogmsgstatus);
1.196     www       955:    } else {
1.2       www       956:        $status='no_host';
1.196     www       957:    }
1.2       www       958:     return $status;
                    959: }
1.38      www       960: 
                    961: sub user_normal_msg {
1.132     www       962:     my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
1.238     raeburn   963: 	$toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid,
1.248     raeburn   964:         $permresults,$senthide)=@_;
1.199     raeburn   965:     my @status;
1.38      www       966:     my %userenv = &Apache::lonnet::get('environment',['msgforward'],
                    967:                                        $domain,$user);
                    968:     my $msgforward=$userenv{'msgforward'};
                    969:     if ($msgforward) {
1.239     raeburn   970:         foreach my $fwd (split(/\,/,$msgforward)) {
                    971: 	    my ($forwuser,$forwdomain)=split(/\:/,$fwd);
1.199     raeburn   972: 	    push(@status,
1.171     banghart  973: 	        &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,
1.172     albertel  974: 				     $citation,$baseurl,$attachmenturl,$toperm,
1.201     raeburn   975: 				     undef,undef,$sentmessage,undef,$symb,
1.248     raeburn   976:                                      $restitle,$error,$nosentstore,$recipid,
                    977:                                      $permresults,$senthide));
1.171     banghart  978:         }
1.191     raeburn   979:     } else {
1.199     raeburn   980: 	push(@status,&user_normal_msg_raw($user,$domain,$subject,$message,
1.172     albertel  981: 				     $citation,$baseurl,$attachmenturl,$toperm,
1.201     raeburn   982: 				     undef,undef,$sentmessage,undef,$symb,
1.248     raeburn   983:                                      $restitle,$error,$nosentstore,$recipid,
                    984:                                      $permresults,$senthide));
1.199     raeburn   985:     }
                    986:     if (wantarray) {
                    987:         return @status;
1.38      www       988:     }
1.199     raeburn   989:     return join(' ',@status);
1.38      www       990: }
                    991: 
1.201     raeburn   992: sub process_sent_mail {
1.236     raeburn   993:     my ($msgsubj,$subj_prefix,$numsent,$stamp,$msgname,$msgdom,$msgcount,
                    994:         $context,$pid,$savemsg,$recusers,$recudoms,$baseurl,$attachmenturl,
                    995:         $symb,$error,$senderuname,$senderdom,$recipid) = @_;
1.201     raeburn   996:     my $sentsubj;
                    997:     if ($numsent > 1) {
                    998:         $sentsubj = $subj_prefix.' ('.$numsent.' sent) '.$msgsubj;
1.205     raeburn   999:     } else {
                   1000:         if ($subj_prefix) {
                   1001:             $sentsubj = $subj_prefix.' ';
                   1002:         }
                   1003:         $sentsubj .= $msgsubj;
1.201     raeburn  1004:     }
                   1005:     $sentsubj = &HTML::Entities::encode($sentsubj,'<>&"');
                   1006:     my $sentmsgid = 
                   1007:         &buildmsgid($stamp,$sentsubj,$msgname,$msgdom,$msgcount,$context,$pid);
                   1008:     (undef,my $sentmessage) =
                   1009:         &packagemsg($msgsubj,$savemsg,undef,$baseurl,$attachmenturl,$recusers,
1.214     raeburn  1010:                     $recudoms,$sentmsgid,undef,undef,$symb,$error,$recipid);
1.201     raeburn  1011:     my $status = &store_sent_mail($sentmsgid,$sentmessage,$senderuname,
1.210     albertel 1012:                                   $senderdom);
1.201     raeburn  1013:     return $status;
                   1014: }
                   1015: 
1.156     raeburn  1016: sub store_sent_mail {
1.210     albertel 1017:     my ($msgid,$message,$senderuname,$senderdom) = @_;
1.201     raeburn  1018:     if ($senderuname eq '') {
                   1019:         $senderuname = $env{'user.name'};
                   1020:     }
                   1021:     if ($senderdom eq '') {
                   1022:         $senderdom = $env{'user.domain'};
                   1023:     }
1.210     albertel 1024:     my $status =' '.&Apache::lonnet::cput('nohist_email_sent',
                   1025: 					  {$msgid => $message},
                   1026: 					  $senderdom,$senderuname);
1.156     raeburn  1027:     return $status;
                   1028: }
1.2       www      1029: 
1.202     raeburn  1030: sub store_recipients {
                   1031:     my ($subject,$sendername,$senderdom,$reciphash) = @_;
                   1032:     my $context = &get_course_context();
1.203     albertel 1033:     my $now = time();
1.202     raeburn  1034:     my $msgcount = &get_uniq();
                   1035:     my $recipid =
                   1036:         &buildmsgid($now,$subject,$sendername,$senderdom,$msgcount,$context,$$);
                   1037:     my %recipinfo = (
                   1038:                          $recipid => $reciphash,
                   1039:                     );
                   1040:     my $status = &Apache::lonnet::put('nohist_emailrecip',\%recipinfo,
                   1041:                                       $senderdom,$sendername); 
                   1042:     if ($status eq 'ok') {
                   1043:         return ($recipid,$status);
                   1044:     } else {
                   1045:         return (undef,$status);
                   1046:     }
                   1047: }
                   1048: 
1.106     www      1049: 
                   1050: sub foldersuffix {
                   1051:     my $folder=shift;
                   1052:     unless ($folder) { return ''; }
1.189     raeburn  1053:     my $suffix;
                   1054:     my %folderhash = &get_user_folders($folder);
                   1055:     if (ref($folderhash{$folder}) eq 'HASH') {
                   1056:         $suffix = '_'.&escape($folderhash{$folder}{'id'});
                   1057:     } else {
                   1058:         $suffix = '_'.&escape($folder);
                   1059:     }
                   1060:     return $suffix;
                   1061: }
                   1062: 
                   1063: 
                   1064: sub get_user_folders {
                   1065:     my ($folder) = @_;
                   1066:     my %userfolders = 
                   1067:           &Apache::lonnet::dump('email_folders',undef,undef,$folder);
                   1068:     my $lock = "\0".'lock_counter'; # locks db while counter incremented
                   1069:     my $counter = "\0".'idcount';   # used in suffix for email db files
                   1070:     if (defined($userfolders{$lock})) {
                   1071:         delete($userfolders{$lock});
                   1072:     }
                   1073:     if (defined($userfolders{$counter})) {
                   1074:         delete($userfolders{$counter});
                   1075:     }
                   1076:     return %userfolders;
1.106     www      1077: }
                   1078: 
1.197     albertel 1079: sub secapply {
                   1080:     my $rec=shift;
                   1081:     my $defaultflag=shift;
                   1082:     $rec=~s/\s+//g;
1.229     raeburn  1083:     unless ($rec =~ /\:/) {
                   1084:         $rec=~s/\@/\:/g;
                   1085:     }
1.197     albertel 1086:     my ($adr,$sections_or_groups)=($rec=~/^([^\(]+)\(([^\)]+)\)/);
                   1087:     if ($sections_or_groups) {
                   1088: 	foreach my $item (split(/\;/,$sections_or_groups)) {
                   1089:             if (($item eq $env{'request.course.sec'}) ||
                   1090:                 ($defaultflag && ($item eq '*'))) {
                   1091:                 return $adr; 
                   1092:             } elsif ($env{'request.course.groups'}) {
                   1093:                 my @usersgroups = split(/:/,$env{'request.course.groups'});
                   1094:                 if (grep(/^\Q$item\E$/,@usersgroups)) {
                   1095:                     return $adr;
                   1096:                 }
                   1097:             } 
                   1098:         }
                   1099:     } else {
                   1100:        return $rec;
                   1101:     }
                   1102:     return '';
                   1103: }
                   1104: 
                   1105: sub decide_receiver {
                   1106:     my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;
                   1107:     &Apache::lonenc::check_decrypt(\$feedurl);
                   1108:     my $typestyle='';
                   1109:     my %to=();
                   1110:     if ($env{'form.discuss'} eq 'author' ||$author) {
                   1111: 	$typestyle.='Submitting as Author Feedback<br />';
                   1112: 	$feedurl=~ m{^/res/($LONCAPA::domain_re)/($LONCAPA::username_re)/};
                   1113: 	$to{$2.':'.$1}=1;
                   1114:     }
                   1115:     my $cid = $env{'request.course.id'};
                   1116:     if ($env{'form.discuss'} eq 'question' ||$question) {
                   1117: 	$typestyle.=&mt('Submitting as Question').'<br />';
                   1118: 	foreach my $item (split(/\,/,$env{'course.'.$cid.'.question.email'})) {
                   1119: 	    my $rec=&secapply($item,$defaultflag);
                   1120: 	    if ($rec) { $to{$rec}=1; }
                   1121: 	} 
                   1122:     }
                   1123:     if ($env{'form.discuss'} eq 'course' ||$course) {
                   1124: 	$typestyle.=&mt('Submitting as Comment').'<br />';
                   1125: 	foreach my $item (split(/\,/,$env{'course.'.$cid.'.comment.email'})) {
                   1126: 	    my $rec=&secapply($item,$defaultflag);
                   1127: 	    if ($rec) { $to{$rec}=1; }
                   1128: 	} 
                   1129:     }
                   1130:     if ($env{'form.discuss'} eq 'policy' ||$policy) {
                   1131: 	$typestyle.=&mt('Submitting as Policy Feedback').'<br />';
                   1132: 	foreach my $item (split(/\,/,$env{'course.'.$cid.'.policy.email'})) {
                   1133: 	    my $rec=&secapply($item,$defaultflag);
                   1134: 	    if ($rec) { $to{$rec}=1; }
                   1135: 	} 
                   1136:     }
                   1137:     if ((scalar(%to) eq '0') && (!$defaultflag)) {
                   1138: 	($typestyle,%to)=
                   1139: 	    &decide_receiver($feedurl,$author,$question,$course,$policy,1);
                   1140:     }
                   1141:     return ($typestyle,%to);
                   1142: }
                   1143: 
1.180     albertel 1144: 1;
1.1       www      1145: __END__
                   1146: 

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