loncom/interface/lonmsg.pm - view

File: [LON-CAPA] / loncom / interface / lonmsg.pm
Revision 1.232: download - view: text, annotated - select for diffs
Sat Mar 5 21:32:02 2011 UTC (13 years, 2 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_10_X, version_2_10_1, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, HEAD, BZ4492-merge, BZ4492-feature_horizontal_radioresponse

- Bug 6413.
  - Subject for notification e-mail uses subject from corresponding LON-CAPA
    message (uness blank), with [LON-CAPA] prepended.

1: # The LearningOnline Network with CAPA 2: # Routines for messaging 3: # 4: # $Id: lonmsg.pm,v 1.232 2011/03/05 21:32:02 raeburn Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: 29: package Apache::lonmsg; 30: 31: =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: 56: =head1 SUBROUTINES 57: 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: 123: =item * B<user_crit_msg($user, $domain, $subject, $message, $sendback, $nosentstore,$recipid,$attachmenturl)>: 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, 151: $error,$nosentstore,$recipid)>: 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 198: 199: =cut 200: 201: use strict; 202: use Apache::lonnet; 203: use HTML::TokeParser(); 204: use Apache::lonlocal; 205: use Mail::Send; 206: use HTML::Entities; 207: use Encode; 208: use LONCAPA qw(:DEFAULT :match); 209: 210: { 211: my $uniq; 212: sub get_uniq { 213: $uniq++; 214: return $uniq; 215: } 216: } 217: 218: 219: 220: sub packagemsg { 221: my ($subject,$message,$citation,$baseurl,$attachmenturl, 222: $recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error,$recipid)=@_; 223: $message =&HTML::Entities::encode($message,'<>&"'); 224: $citation=&HTML::Entities::encode($citation,'<>&"'); 225: $subject =&HTML::Entities::encode($subject,'<>&"'); 226: #remove machine specification 227: $baseurl =~ s|^https?://[^/]+/|/|; 228: $baseurl =&HTML::Entities::encode($baseurl,'<>&"'); 229: #remove machine specification 230: $attachmenturl =~ s|^https?://[^/]+/|/|; 231: $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"'); 232: my $course_context = &get_course_context(); 233: my $now=time; 234: my $msgcount = &get_uniq(); 235: unless(defined($msgid)) { 236: $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'}, 237: $msgcount,$course_context,$symb,$error,$$); 238: } 239: my $result = '<sendername>'.$env{'user.name'}.'</sendername>'. 240: '<senderdomain>'.$env{'user.domain'}.'</senderdomain>'. 241: '<subject>'.$subject.'</subject>'. 242: '<time>'.&Apache::lonlocal::locallocaltime($now).'</time>'; 243: if (defined($crsmsgid)) { 244: $result.= '<courseid>'.$course_context.'</courseid>'. 245: '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'. 246: '<msgid>'.$msgid.'</msgid>'. 247: '<coursemsgid>'.$crsmsgid.'</coursemsgid>'. 248: '<message>'.$message.'</message>'; 249: return ($msgid,$result); 250: } 251: $result .= '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'. 252: '<host>'.$ENV{'HTTP_HOST'}.'</host>'. 253: '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'. 254: '<browsertype>'.$env{'browser.type'}.'</browsertype>'. 255: '<browseros>'.$env{'browser.os'}.'</browseros>'. 256: '<browserversion>'.$env{'browser.version'}.'</browserversion>'. 257: '<browsermathml>'.$env{'browser.mathml'}.'</browsermathml>'. 258: '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'. 259: '<courseid>'.$course_context.'</courseid>'. 260: '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'. 261: '<role>'.$env{'request.role'}.'</role>'. 262: '<resource>'.$env{'request.filename'}.'</resource>'. 263: '<msgid>'.$msgid.'</msgid>'; 264: if (defined($env{'form.group'})) { 265: $result .= '<group>'.$env{'form.group'}.'</group>'; 266: } 267: if (ref($recuser) eq 'ARRAY') { 268: for (my $i=0; $i<@{$recuser}; $i++) { 269: if ($type eq 'dcmail') { 270: my ($username,$email) = split(/:/,$$recuser[$i]); 271: $username = &unescape($username); 272: $email = &unescape($email); 273: $username = &HTML::Entities::encode($username,'<>&"'); 274: $email = &HTML::Entities::encode($email,'<>&"'); 275: $result .= '<recipient username="'.$username.'">'. 276: $email.'</recipient>'; 277: } else { 278: $result .= '<recuser>'.$$recuser[$i].'</recuser>'. 279: '<recdomain>'.$$recdomain[$i].'</recdomain>'; 280: } 281: } 282: } else { 283: $result .= '<recuser>'.$recuser.'</recuser>'. 284: '<recdomain>'.$recdomain.'</recdomain>'; 285: } 286: $result .= '<message>'.$message.'</message>'; 287: if (defined($citation)) { 288: $result.='<citation>'.$citation.'</citation>'; 289: } 290: if (defined($baseurl)) { 291: $result.= '<baseurl>'.$baseurl.'</baseurl>'; 292: } 293: if (defined($attachmenturl)) { 294: $result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>'; 295: } 296: if (defined($symb)) { 297: $result.= '<symb>'.$symb.'</symb>'; 298: if ($course_context ne '') { 299: if ($course_context eq $env{'request.course.id'}) { 300: my $resource_title = &Apache::lonnet::gettitle($symb); 301: if (defined($resource_title)) { 302: $result .= '<resource_title>'.$resource_title.'</resource_title>'; 303: } 304: } 305: } 306: } 307: if (defined($recipid)) { 308: $result.= '<recipid>'.$recipid.'</recipid>'; 309: } 310: if ($env{'form.can_reply'} eq 'N') { 311: $result .= '<noreplies>1</noreplies>'; 312: } 313: if ($env{'form.reply_to_addr'}) { 314: my ($replytoname,$replytodom) = split(/:/,$env{'form.reply_to_addr'}); 315: if (!($replytoname eq $env{'user.name'} && $replytodom eq $env{'user.domain'})) { 316: if (&Apache::lonnet::homeserver($replytoname,$replytodom) ne 'no_host') { 317: $result .= '<replytoaddr>'.$env{'form.reply_to_addr'}.'</replytoaddr>'; 318: } 319: } 320: } 321: return ($msgid,$result); 322: } 323: 324: sub get_course_context { 325: my $course_context; 326: my $msgkey; 327: if (defined($env{'form.replyid'})) { 328: $msgkey = $env{'form.replyid'}; 329: } elsif (defined($env{'form.forwid'})) { 330: $msgkey = $env{'form.forwid'} 331: } elsif (defined($env{'form.multiforwid'})) { 332: $msgkey = $env{'form.multiforwid'}; 333: } 334: if ($msgkey ne '') { 335: my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)= 336: split(/\:/,&unescape($msgkey)); 337: $course_context = $origcid; 338: } 339: foreach my $key (keys(%env)) { 340: if ($key=~/^form\.(rep)?rec\_(.*)$/) { 341: my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid) = 342: split(/\:/,&unescape($2)); 343: $course_context = $origcid; 344: last; 345: } 346: } 347: if ($course_context eq '') { 348: $course_context = $env{'request.course.id'}; 349: } 350: return $course_context; 351: } 352: 353: 354: sub unpackagemsg { 355: my ($message,$notoken,$noattachmentlink)=@_; 356: my %content=(); 357: my $parser=HTML::TokeParser->new(\$message); 358: my $token; 359: while ($token=$parser->get_token) { 360: if ($token->[0] eq 'S') { 361: my $entry=$token->[1]; 362: my $value=$parser->get_text('/'.$entry); 363: if (($entry eq 'recuser') || ($entry eq 'recdomain')) { 364: push(@{$content{$entry}},$value); 365: } elsif ($entry eq 'recipient') { 366: my $username = $token->[2]{'username'}; 367: $username = &HTML::Entities::decode($username,'<>&"'); 368: $content{$entry}{$username} = $value; 369: } else { 370: $content{$entry}=$value; 371: } 372: } 373: } 374: if (!exists($content{'recuser'})) { $content{'recuser'} = []; } 375: if (($content{'attachmenturl'}) && (!$noattachmentlink)) { 376: my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|); 377: if ($notoken) { 378: $content{'message'}.=''.&mt('Attachment').': <tt>'.$fname.'</tt>'; 379: } else { 380: &Apache::lonnet::allowuploaded('/adm/msg', 381: $content{'attachmenturl'}); 382: $content{'message'}.=''.&mt('Attachment'). 383: ': <a href="'.$content{'attachmenturl'}.'"><tt>'. 384: $fname.'</tt></a>'; 385: } 386: } 387: return %content; 388: } 389: 390: 391: sub buildmsgid { 392: my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_; 393: $subject=&escape($subject); 394: $symb = &escape($symb); 395: return(&escape($now.':'.$subject.':'.$uname.':'. 396: $udom.':'.$msgcount.':'.$course_context.':'.$pid.':'.$symb.':'.$error)); 397: } 398: 399: sub unpackmsgid { 400: my ($msgid,$folder,$skipstatus,$status_cache)=@_; 401: $msgid=&unescape($msgid); 402: my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid, 403: $processid,$symb,$error) = split(/\:/,&unescape($msgid)); 404: $shortsubj = &unescape($shortsubj); 405: $shortsubj = &HTML::Entities::decode($shortsubj); 406: $symb = &unescape($symb); 407: if (!defined($processid)) { $fromcid = ''; } 408: my %status=(); 409: unless ($skipstatus) { 410: if (ref($status_cache)) { 411: $status{$msgid} = $status_cache->{$msgid}; 412: } else { 413: my $suffix=&foldersuffix($folder); 414: %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]); 415: } 416: if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } 417: unless ($status{$msgid}) { $status{$msgid}='new'; } 418: } 419: return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid,$symb,$error); 420: } 421: 422: 423: sub sendemail { 424: my ($to,$subject,$body,$to_uname,$to_udom,$user_lh)=@_; 425: my $senderaddress=''; 426: my $replytoaddress=''; 427: if ($env{'form.can_reply'} eq 'N') { 428: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; 429: my $hostname = &Apache::lonnet::hostname($lonhost); 430: $replytoaddress = 'do-not-reply@'.$hostname; 431: } else { 432: my %senderemails; 433: my $have_sender; 434: if ($env{'form.reply_to_addr'}) { 435: my ($replytoname,$replytodom) = split(/:/,$env{'form.reply_to_addr'}); 436: if (!($replytoname eq $env{'user.name'} && $replytodom eq $env{'user.domain'})) { 437: if (&Apache::lonnet::homeserver($replytoname,$replytodom) ne 'no_host') { 438: %senderemails = 439: &Apache::loncommon::getemails($replytoname,$replytodom); 440: $have_sender = 1; 441: } 442: } 443: } 444: if (!$have_sender) { 445: %senderemails=&Apache::loncommon::getemails(); 446: } 447: foreach my $type ('permanentemail','critnotification','notification') { 448: if ($senderemails{$type}) { 449: ($senderaddress) = split(/,/,$senderemails{$type}); 450: last if ($senderaddress); 451: } 452: } 453: } 454: $body= 455: "*** ".&mt_user($user_lh,'This is an automatic e-mail generated by the LON-CAPA system.')."\n". 456: "*** ".($senderaddress?&mt_user($user_lh,'You can reply to this e-mail'):&mt_user($user_lh,'Please do not reply to this address.')."\n*** ". 457: &mt_user($user_lh,'A reply will not be received by the recipient!'))."\n\n".$body; 458: 459: my $msg = new Mail::Send; 460: $msg->to($to); 461: $msg->subject('[LON-CAPA] '.$subject); 462: if ($replytoaddress) { 463: $msg->add('Reply-to',$replytoaddress); 464: } 465: if ($senderaddress) { 466: $msg->add('From',$senderaddress); 467: } 468: $msg->add('Content-type','text/plain; charset=UTF-8'); 469: if (my $fh = $msg->open()) { 470: print $fh $body; 471: $fh->close; 472: } 473: } 474: 475: # ==================================================== Send notification emails 476: 477: sub sendnotification { 478: my ($to,$touname,$toudom,$subj,$crit,$text,$msgid)=@_; 479: my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'}; 480: unless ($sender=~/\w/) { 481: $sender=$env{'user.name'}.':'.$env{'user.domain'}; 482: } 483: my $critical=($crit?' critical':''); 484: 485: $text=~s/\&lt\;/\</gs; 486: $text=~s/\&gt\;/\>/gs; 487: my $homeserver = &Apache::lonnet::homeserver($touname,$toudom); 488: my $protocol = $Apache::lonnet::protocol{$homeserver}; 489: $protocol = 'http' if ($protocol ne 'https'); 490: my $url = $protocol.'://'.&Apache::lonnet::hostname($homeserver). 491: '/adm/email?username='.$touname.'&domain='.$toudom. 492: '&display='.&escape($msgid); 493: my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid, 494: $symb,$error) = &Apache::lonmsg::unpackmsgid($msgid); 495: my ($coursetext,$body,$bodybegin,$bodysubj,$bodyend); 496: my $user_lh = &Apache::loncommon::user_lang($touname,$toudom,$fromcid); 497: if ($fromcid ne '') { 498: $coursetext = "\n".&mt_user($user_lh,'Course').': '; 499: if ($env{'course.'.$fromcid.'.description'} ne '') { 500: $coursetext .= $env{'course.'.$fromcid.'.description'}; 501: } else { 502: my %coursehash = &Apache::lonnet::coursedescription($fromcid,); 503: if ($coursehash{'description'} ne '') { 504: $coursetext .= $coursehash{'description'}; 505: } 506: } 507: $coursetext .= "\n\n"; 508: } 509: my @recipients = split(/,/,$to); 510: $bodybegin = $coursetext. 511: &mt_user($user_lh, 512: 'You received a'.$critical.' message from [_1] in LON-CAPA.',$sender).' '; 513: $bodysubj = &mt_user($user_lh,'The subject is 514: 515: [_1] 516: 517: ',$subj)."\n". 518: '=== '.&mt_user($user_lh,'Excerpt')." ============================================================ 519: "; 520: $bodyend = " 521: ======================================================================== 522: 523: ".&mt_user($user_lh,'Use 524: 525: [_1] 526: 527: to access the full message.',$url); 528: my %userenv = &Apache::lonnet::get('environment',['notifywithhtml'],$toudom,$touname); 529: my $subject = &mt_user($user_lh,"'New' $critical message from ").$sender; 530: unless ($subj eq '') { 531: $subject = $subj; 532: } 533: 534: my ($blocked,$blocktext); 535: if (!$crit) { 536: my %setters; 537: my ($startblock,$endblock) = 538: &Apache::loncommon::blockcheck(\%setters,'com',$touname,$toudom); 539: if ($startblock && $endblock) { 540: $blocked = 1; 541: my $showstart = &Apache::lonlocal::locallocaltime($startblock); 542: my $showend = &Apache::lonlocal::locallocaltime($endblock); 543: $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); 544: } 545: } 546: if ($userenv{'notifywithhtml'} ne '') { 547: my @htmlexcerpt = split(/,/,$userenv{'notifywithhtml'}); 548: my $htmlfree = &make_htmlfree($text); 549: foreach my $addr (@recipients) { 550: if ($blocked) { 551: $body = $bodybegin."\n".$blocktext."\n".$bodyend; 552: } else { 553: my $sendtext; 554: if (!grep/^\Q$addr\E/,@htmlexcerpt) { 555: $sendtext = $htmlfree; 556: } else { 557: $sendtext = $text; 558: } 559: $body = $bodybegin.$bodysubj.$sendtext.$bodyend; 560: } 561: &sendemail($addr,$subject,$body,$touname,$toudom,$user_lh); 562: } 563: } else { 564: if ($blocked) { 565: $body = $bodybegin."\n".$blocktext."\n".$bodyend; 566: } else { 567: my $htmlfree = &make_htmlfree($text); 568: $body = $bodybegin.$bodysubj.$htmlfree.$bodyend; 569: } 570: &sendemail($to,$subject,$body,$touname,$toudom,$user_lh); 571: } 572: } 573: 574: sub make_htmlfree { 575: my ($text) = @_; 576: $text =~ s/\<\/*[^\>]+\>//gs; 577: $text = &HTML::Entities::decode($text); 578: $text = &Encode::encode('utf8',$text); 579: return $text; 580: } 581: 582: sub mynewmail{ 583: &newmail(); 584: return $env{'user.mailcheck.lastnewmessagetime'} > $env{'user.mailcheck.lastvisit'}; 585: } 586: 587: 588: sub newmail { 589: if ((time-$env{'user.mailcheck.time'})>300) { 590: my %what=&Apache::lonnet::get('email_status',['recnewemail']); 591: &Apache::lonnet::appenv({'user.mailcheck.time'=>time}); 592: &Apache::lonnet::appenv({'user.mailcheck.lastnewmessagetime'=> $what{'recnewemail'}}); 593: if ($what{'recnewemail'}>0) { return 1; } 594: } 595: return 0; 596: } 597: 598: 599: 600: sub author_res_msg { 601: my ($filename,$message)=@_; 602: unless ($message) { return 'empty'; } 603: $filename=&Apache::lonnet::declutter($filename); 604: my ($domain,$author,@dummy)=split(/\//,$filename); 605: my $homeserver=&Apache::lonnet::homeserver($author,$domain); 606: if ($homeserver ne 'no_host') { 607: my $id=unpack("%32C*",$message); 608: $message .= " This error occurred on machine ". 609: $Apache::lonnet::perlvar{'lonHostID'}.""; 610: my $msgid; 611: ($msgid,$message)=&packagemsg($filename,$message); 612: return &Apache::lonnet::reply('put:'.$domain.':'.$author. 613: ':nohist_res_msgs:'. 614: &escape($filename.'_'.$id).'='. 615: &escape($message),$homeserver); 616: } 617: return 'no_host'; 618: } 619: 620: 621: 622: sub retrieve_author_res_msg { 623: my $url=shift; 624: $url=&Apache::lonnet::declutter($url); 625: my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); 626: my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author); 627: my $msgs=''; 628: foreach (keys %errormsgs) { 629: if ($_=~/^\Q$url\E\_\d+$/) { 630: my %content=&unpackagemsg($errormsgs{$_}); 631: $msgs.='<img src="/adm/lonMisc/bomb.gif" />'. 632: $content{'time'}.': '.$content{'message'}. 633: ' '; 634: } 635: } 636: return $msgs; 637: } 638: 639: 640: 641: 642: 643: sub del_url_author_res_msg { 644: my $url=shift; 645: $url=&Apache::lonnet::declutter($url); 646: my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); 647: my @delmsgs=(); 648: foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { 649: if ($_=~/^\Q$url\E\_\d+$/) { 650: push (@delmsgs,$_); 651: } 652: } 653: return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); 654: } 655: 656: 657: sub clear_author_res_msg { 658: my $url=shift; 659: $url=&Apache::lonnet::declutter($url); 660: my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); 661: my @delmsgs=(); 662: foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { 663: if ($_=~/^\Q$url\E/) { 664: push (@delmsgs,$_); 665: } 666: } 667: return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); 668: } 669: 670: 671: 672: sub all_url_author_res_msg { 673: my ($author,$domain)=@_; 674: my %returnhash=(); 675: foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { 676: $_=~/^(.+)\_\d+/; 677: $returnhash{$1}=1; 678: } 679: return %returnhash; 680: } 681: 682: 683: sub store_instructor_comment { 684: my ($msg,$uname,$udom) = @_; 685: my $cid = $env{'request.course.id'}; 686: my $cnum = $env{'course.'.$cid.'.num'}; 687: my $cdom = $env{'course.'.$cid.'.domain'}; 688: my $subject= &mt('Record').' ['.$uname.':'.$udom.']'; 689: my $result = &user_normal_msg_raw($cnum,$cdom,$subject,$msg); 690: if ($result eq 'ok' || $result eq 'con_delayed') { 691: 692: } 693: return $result; 694: } 695: 696: 697: sub user_crit_msg_raw { 698: my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage, 699: $nosentstore,$recipid,$attachmenturl)=@_; 700: # Check if allowed missing 701: my ($status,$packed_message); 702: my $msgid='undefined'; 703: unless (($message)&&($user)&&($domain)) { $status='empty'; }; 704: my $text=$message; 705: my $homeserver=&Apache::lonnet::homeserver($user,$domain); 706: if ($homeserver ne 'no_host') { 707: ($msgid,$packed_message)=&packagemsg($subject,$message,undef,undef, 708: $attachmenturl,undef,undef,undef,undef,undef, 709: undef,undef,$recipid); 710: if ($sendback) { $packed_message.='<sendback>true</sendback>'; } 711: $status=&Apache::lonnet::cput('critical', {$msgid => $packed_message}, 712: $domain,$user); 713: if (defined($sentmessage)) { 714: $$sentmessage = $packed_message; 715: } 716: if (!$nosentstore) { 717: (undef,my $packed_message_no_citation) = 718: &packagemsg($subject,$message,undef,undef,$attachmenturl,$user, 719: $domain,$msgid); 720: if ($status eq 'ok' || $status eq 'con_delayed') { 721: &store_sent_mail($msgid,$packed_message_no_citation); 722: } 723: } 724: } else { 725: $status='no_host'; 726: } 727: 728: # Notifications 729: my %userenv = &Apache::loncommon::getemails($user,$domain); 730: if ($userenv{'critnotification'}) { 731: &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1, 732: $text,$msgid); 733: } 734: if ($toperm && $userenv{'permanentemail'}) { 735: &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1, 736: $text,$msgid); 737: } 738: # Log this 739: &Apache::lonnet::logthis( 740: 'Sending critical email '.$msgid. 741: ', log status: '. 742: &Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, 743: $env{'user.home'}, 744: 'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: ' 745: .$status)); 746: return $status; 747: } 748: 749: 750: 751: sub user_crit_msg { 752: my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage, 753: $nosentstore,$recipid,$attachmenturl)=@_; 754: my @status; 755: my %userenv = &Apache::lonnet::get('environment',['msgforward'], 756: $domain,$user); 757: my $msgforward=$userenv{'msgforward'}; 758: if ($msgforward) { 759: foreach my $addr (split(/\,/,$msgforward)) { 760: my ($forwuser,$forwdomain)=split(/\:/,$addr); 761: push(@status, 762: &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message, 763: $sendback,$toperm,$sentmessage,$nosentstore, 764: $recipid,$attachmenturl)); 765: } 766: } else { 767: push(@status, 768: &user_crit_msg_raw($user,$domain,$subject,$message,$sendback, 769: $toperm,$sentmessage,$nosentstore,$recipid, 770: $attachmenturl)); 771: } 772: if (wantarray) { 773: return @status; 774: } 775: return join(' ',@status); 776: } 777: 778: 779: sub user_crit_received { 780: my $msgid=shift; 781: my %message=&Apache::lonnet::get('critical',[$msgid]); 782: my %contents=&unpackagemsg($message{$msgid},1); 783: my $destname = $contents{'sendername'}; 784: my $destdom = $contents{'senderdomain'}; 785: if ($contents{'replytoaddr'}) { 786: my ($repname,$repdom) = split(/:/,$contents{'replytoaddr'}); 787: if (&Apache::lonnet::homeserver($repname,$repdom) ne 'no_host') { 788: $destname = $repname; 789: $destdom = $repdom; 790: } 791: } 792: my $status='rec: '.($contents{'sendback'}? 793: &user_normal_msg($destname,$destdom,&mt('Receipt').': '.$env{'user.name'}. 794: ' '.&mt('at').' '.$env{'user.domain'}.', '. 795: $contents{'subject'},&mt('User').' '.$env{'user.name'}. 796: ' '.&mt('at').' '.$env{'user.domain'}. 797: ' acknowledged receipt of message'."\n".' "'. 798: $contents{'subject'}.'"'."\n".&mt('dated').' '. 799: $contents{'time'}.".\n" 800: ):'no msg req'); 801: $status.=' trans: '. 802: &Apache::lonnet::put( 803: 'nohist_email',{$contents{'msgid'} => $message{$msgid}}); 804: $status.=' del: '. 805: &Apache::lonnet::del('critical',[$contents{'msgid'}]); 806: &Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, 807: $env{'user.home'},'Received critical message '. 808: $contents{'msgid'}. 809: ', '.$status); 810: return $status; 811: } 812: 813: 814: 815: 816: sub user_normal_msg_raw { 817: my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, 818: $toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle, 819: $error,$nosentstore,$recipid)=@_; 820: # Check if allowed missing 821: my ($status,$packed_message); 822: my $msgid='undefined'; 823: my $text=$message; 824: unless (($message)&&($user)&&($domain)) { $status='empty'; }; 825: my $homeserver=&Apache::lonnet::homeserver($user,$domain); 826: if ($homeserver ne 'no_host') { 827: ($msgid,$packed_message)= 828: &packagemsg($subject,$message,$citation,$baseurl, 829: $attachmenturl,$user,$domain,$currid, 830: undef,$crsmsgid,$symb,$error,$recipid); 831: 832: # Store in user folder 833: $status= 834: &Apache::lonnet::cput('nohist_email',{$msgid => $packed_message}, 835: $domain,$user); 836: # Save new message received time 837: &Apache::lonnet::put 838: ('email_status',{'recnewemail'=>time},$domain,$user); 839: # Into sent-mail folder if sent mail storage required 840: if (!$nosentstore) { 841: (undef,my $packed_message_no_citation) = 842: &packagemsg($subject,$message,undef,$baseurl,$attachmenturl, 843: $user,$domain,$currid,undef,$crsmsgid,$symb,$error); 844: if ($status eq 'ok' || $status eq 'con_delayed') { 845: &store_sent_mail($msgid,$packed_message_no_citation); 846: } 847: } 848: if (ref($newid) eq 'SCALAR') { 849: $$newid = $msgid; 850: } 851: if (ref($sentmessage) eq 'SCALAR') { 852: $$sentmessage = $packed_message; 853: } 854: # Notifications 855: my %userenv = &Apache::loncommon::getemails($user,$domain); 856: if ($userenv{'notification'}) { 857: &sendnotification($userenv{'notification'},$user,$domain,$subject,0, 858: $text,$msgid); 859: } 860: if ($toperm && $userenv{'permanentemail'}) { 861: if ((!$userenv{'notification'}) || ($userenv{'notification'} ne $userenv{'permanentemail'})) { 862: &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0, 863: $text,$msgid); 864: } 865: } 866: &Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, 867: $env{'user.home'}, 868: 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status); 869: } else { 870: $status='no_host'; 871: } 872: return $status; 873: } 874: 875: sub user_normal_msg { 876: my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, 877: $toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid)=@_; 878: my @status; 879: my %userenv = &Apache::lonnet::get('environment',['msgforward'], 880: $domain,$user); 881: my $msgforward=$userenv{'msgforward'}; 882: if ($msgforward) { 883: foreach (split(/\,/,$msgforward)) { 884: my ($forwuser,$forwdomain)=split(/\:/,$_); 885: push(@status, 886: &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message, 887: $citation,$baseurl,$attachmenturl,$toperm, 888: undef,undef,$sentmessage,undef,$symb, 889: $restitle,$error,$nosentstore,$recipid)); 890: } 891: } else { 892: push(@status,&user_normal_msg_raw($user,$domain,$subject,$message, 893: $citation,$baseurl,$attachmenturl,$toperm, 894: undef,undef,$sentmessage,undef,$symb, 895: $restitle,$error,$nosentstore,$recipid)); 896: } 897: if (wantarray) { 898: return @status; 899: } 900: return join(' ',@status); 901: } 902: 903: sub process_sent_mail { 904: my ($msgsubj,$subj_prefix,$numsent,$stamp,$msgname,$msgdom,$msgcount,$context,$pid,$savemsg,$recusers,$recudoms,$baseurl,$attachmenturl,$symb,$error,$senderuname,$senderdom,$recipid) = @_; 905: my $sentsubj; 906: if ($numsent > 1) { 907: $sentsubj = $subj_prefix.' ('.$numsent.' sent) '.$msgsubj; 908: } else { 909: if ($subj_prefix) { 910: $sentsubj = $subj_prefix.' '; 911: } 912: $sentsubj .= $msgsubj; 913: } 914: $sentsubj = &HTML::Entities::encode($sentsubj,'<>&"'); 915: my $sentmsgid = 916: &buildmsgid($stamp,$sentsubj,$msgname,$msgdom,$msgcount,$context,$pid); 917: (undef,my $sentmessage) = 918: &packagemsg($msgsubj,$savemsg,undef,$baseurl,$attachmenturl,$recusers, 919: $recudoms,$sentmsgid,undef,undef,$symb,$error,$recipid); 920: my $status = &store_sent_mail($sentmsgid,$sentmessage,$senderuname, 921: $senderdom); 922: return $status; 923: } 924: 925: sub store_sent_mail { 926: my ($msgid,$message,$senderuname,$senderdom) = @_; 927: if ($senderuname eq '') { 928: $senderuname = $env{'user.name'}; 929: } 930: if ($senderdom eq '') { 931: $senderdom = $env{'user.domain'}; 932: } 933: my $status =' '.&Apache::lonnet::cput('nohist_email_sent', 934: {$msgid => $message}, 935: $senderdom,$senderuname); 936: return $status; 937: } 938: 939: sub store_recipients { 940: my ($subject,$sendername,$senderdom,$reciphash) = @_; 941: my $context = &get_course_context(); 942: my $now = time(); 943: my $msgcount = &get_uniq(); 944: my $recipid = 945: &buildmsgid($now,$subject,$sendername,$senderdom,$msgcount,$context,$$); 946: my %recipinfo = ( 947: $recipid => $reciphash, 948: ); 949: my $status = &Apache::lonnet::put('nohist_emailrecip',\%recipinfo, 950: $senderdom,$sendername); 951: if ($status eq 'ok') { 952: return ($recipid,$status); 953: } else { 954: return (undef,$status); 955: } 956: } 957: 958: 959: sub foldersuffix { 960: my $folder=shift; 961: unless ($folder) { return ''; } 962: my $suffix; 963: my %folderhash = &get_user_folders($folder); 964: if (ref($folderhash{$folder}) eq 'HASH') { 965: $suffix = '_'.&escape($folderhash{$folder}{'id'}); 966: } else { 967: $suffix = '_'.&escape($folder); 968: } 969: return $suffix; 970: } 971: 972: 973: sub get_user_folders { 974: my ($folder) = @_; 975: my %userfolders = 976: &Apache::lonnet::dump('email_folders',undef,undef,$folder); 977: my $lock = "\0".'lock_counter'; # locks db while counter incremented 978: my $counter = "\0".'idcount'; # used in suffix for email db files 979: if (defined($userfolders{$lock})) { 980: delete($userfolders{$lock}); 981: } 982: if (defined($userfolders{$counter})) { 983: delete($userfolders{$counter}); 984: } 985: return %userfolders; 986: } 987: 988: sub secapply { 989: my $rec=shift; 990: my $defaultflag=shift; 991: $rec=~s/\s+//g; 992: unless ($rec =~ /\:/) { 993: $rec=~s/\@/\:/g; 994: } 995: my ($adr,$sections_or_groups)=($rec=~/^([^$]+)\(([^$]+)\)/); 996: if ($sections_or_groups) { 997: foreach my $item (split(/\;/,$sections_or_groups)) { 998: if (($item eq $env{'request.course.sec'}) || 999: ($defaultflag && ($item eq '*'))) { 1000: return $adr; 1001: } elsif ($env{'request.course.groups'}) { 1002: my @usersgroups = split(/:/,$env{'request.course.groups'}); 1003: if (grep(/^\Q$item\E$/,@usersgroups)) { 1004: return $adr; 1005: } 1006: } 1007: } 1008: } else { 1009: return $rec; 1010: } 1011: return ''; 1012: } 1013: 1014: sub decide_receiver { 1015: my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_; 1016: &Apache::lonenc::check_decrypt(\$feedurl); 1017: my $typestyle=''; 1018: my %to=(); 1019: if ($env{'form.discuss'} eq 'author' ||$author) { 1020: $typestyle.='Submitting as Author Feedback '; 1021: $feedurl=~ m{^/res/($LONCAPA::domain_re)/($LONCAPA::username_re)/}; 1022: $to{$2.':'.$1}=1; 1023: } 1024: my $cid = $env{'request.course.id'}; 1025: if ($env{'form.discuss'} eq 'question' ||$question) { 1026: $typestyle.=&mt('Submitting as Question').' '; 1027: foreach my $item (split(/\,/,$env{'course.'.$cid.'.question.email'})) { 1028: my $rec=&secapply($item,$defaultflag); 1029: if ($rec) { $to{$rec}=1; } 1030: } 1031: } 1032: if ($env{'form.discuss'} eq 'course' ||$course) { 1033: $typestyle.=&mt('Submitting as Comment').' '; 1034: foreach my $item (split(/\,/,$env{'course.'.$cid.'.comment.email'})) { 1035: my $rec=&secapply($item,$defaultflag); 1036: if ($rec) { $to{$rec}=1; } 1037: } 1038: } 1039: if ($env{'form.discuss'} eq 'policy' ||$policy) { 1040: $typestyle.=&mt('Submitting as Policy Feedback').' '; 1041: foreach my $item (split(/\,/,$env{'course.'.$cid.'.policy.email'})) { 1042: my $rec=&secapply($item,$defaultflag); 1043: if ($rec) { $to{$rec}=1; } 1044: } 1045: } 1046: if ((scalar(%to) eq '0') && (!$defaultflag)) { 1047: ($typestyle,%to)= 1048: &decide_receiver($feedurl,$author,$question,$course,$policy,1); 1049: } 1050: return ($typestyle,%to); 1051: } 1052: 1053: 1; 1054: __END__ 1055: