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

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

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