File:
[LON-CAPA] /
loncom /
interface /
lonmsg.pm
Revision
1.191:
download - view:
text,
annotated -
select for diffs
Sun Dec 24 22:13:19 2006 UTC (17 years, 6 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
Include symb in msgid when sending feedback about a resource.
Include an error bit in msgid (1 if message is a "bomb" caused by an error when rendering a problem.
Include symb and resource title in messsage (<symb> and <resource_title> tags) when feedback is about a resource.
Navigate Contents page now checks for unread feedback or errors using symb instead of just resource url.
Navigate Contents page checks for resource context based on symb in msgid instead of in [url] included in message subject. Backwards compatibility with old-style messages retained.
Subject for feedback messages about resources appends message title instead of url inside [].
Title on feedback page now avoids leaking unencrypted file name in cases where no title was assigned to a resource with hidden url.
When displaying feedback messages about a resource in a course, "Refers to" link displayed when viewer has corresponding course role selected includes symb in the link. Link text is now resource title.
"Refers to" link points to unencrypted resource url if feedback message is viewed under role other than original course, only if user has bre privilege for the resource, otherwise "Refers to" link is not displayed.
lonfeedback -- Some replacement of decode_symb() and &clutter() and &dewrapper() with &get_feedurl_and_clean_symb() for replies and edits of discussion posts.
lonfeedback -- More work on in ensuring hidden urls are encrypted or unencrypted as required.
1: # The LearningOnline Network with CAPA
2: # Routines for messaging
3: #
4: # $Id: lonmsg.pm,v 1.191 2006/12/24 22:13:19 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: use strict;
32: use Apache::lonnet;
33: use HTML::TokeParser();
34: use Apache::lonlocal;
35: use Mail::Send;
36: use LONCAPA qw(:DEFAULT :match);
37:
38: {
39: my $uniq;
40: sub get_uniq {
41: $uniq++;
42: return $uniq;
43: }
44: }
45:
46: # ===================================================================== Package
47:
48: sub packagemsg {
49: my ($subject,$message,$citation,$baseurl,$attachmenturl,
50: $recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error)=@_;
51: $message =&HTML::Entities::encode($message,'<>&"');
52: $citation=&HTML::Entities::encode($citation,'<>&"');
53: $subject =&HTML::Entities::encode($subject,'<>&"');
54: #remove machine specification
55: $baseurl =~ s|^http://[^/]+/|/|;
56: $baseurl =&HTML::Entities::encode($baseurl,'<>&"');
57: #remove machine specification
58: $attachmenturl =~ s|^http://[^/]+/|/|;
59: $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
60: my $course_context;
61: if (defined($env{'form.replyid'})) {
62: my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)=
63: split(/\:/,&unescape($env{'form.replyid'}));
64: $course_context = $origcid;
65: }
66: foreach my $key (keys(%env)) {
67: if ($key=~/^form\.(rep)?rec\_(.*)$/) {
68: my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid) =
69: split(/\:/,&unescape($2));
70: $course_context = $origcid;
71: last;
72: }
73: }
74: unless(defined($course_context)) {
75: $course_context = $env{'request.course.id'};
76: }
77: my $now=time;
78: my $msgcount = &get_uniq();
79: unless(defined($msgid)) {
80: $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'},
81: $msgcount,$course_context,$symb,$error,$$);
82: }
83: my $result = '<sendername>'.$env{'user.name'}.'</sendername>'.
84: '<senderdomain>'.$env{'user.domain'}.'</senderdomain>'.
85: '<subject>'.$subject.'</subject>'.
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>'.
96: '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
97: '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
98: '<browsertype>'.$env{'browser.type'}.'</browsertype>'.
99: '<browseros>'.$env{'browser.os'}.'</browseros>'.
100: '<browserversion>'.$env{'browser.version'}.'</browserversion>'.
101: '<browsermathml>'.$env{'browser.mathml'}.'</browsermathml>'.
102: '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
103: '<courseid>'.$course_context.'</courseid>'.
104: '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'.
105: '<role>'.$env{'request.role'}.'</role>'.
106: '<resource>'.$env{'request.filename'}.'</resource>'.
107: '<msgid>'.$msgid.'</msgid>';
108: if (ref($recuser) eq 'ARRAY') {
109: for (my $i=0; $i<@{$recuser}; $i++) {
110: if ($type eq 'dcmail') {
111: my ($username,$email) = split(/:/,$$recuser[$i]);
112: $username = &unescape($username);
113: $email = &unescape($email);
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: }
122: }
123: } else {
124: $result .= '<recuser>'.$recuser.'</recuser>'.
125: '<recdomain>'.$recdomain.'</recdomain>';
126: }
127: $result .= '<message>'.$message.'</message>';
128: if (defined($citation)) {
129: $result.='<citation>'.$citation.'</citation>';
130: }
131: if (defined($baseurl)) {
132: $result.= '<baseurl>'.$baseurl.'</baseurl>';
133: }
134: if (defined($attachmenturl)) {
135: $result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>';
136: }
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);
149: }
150:
151: # ================================================== Unpack message into a hash
152:
153: sub unpackagemsg {
154: my ($message,$notoken)=@_;
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);
162: if (($entry eq 'recuser') || ($entry eq 'recdomain')) {
163: push(@{$content{$entry}},$value);
164: } elsif ($entry eq 'recipient') {
165: my $username = $token->[2]{'username'};
166: $username = &HTML::Entities::decode($username,'<>&"');
167: $content{$entry}{$username} = $value;
168: } else {
169: $content{$entry}=$value;
170: }
171: }
172: }
173: if (!exists($content{'recuser'})) { $content{'recuser'} = []; }
174: if ($content{'attachmenturl'}) {
175: my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);
176: if ($notoken) {
177: $content{'message'}.='<p>'.&mt('Attachment').': <tt>'.$fname.'</tt>';
178: } else {
179: &Apache::lonnet::allowuploaded('/adm/msg',
180: $content{'attachmenturl'});
181: $content{'message'}.='<p>'.&mt('Attachment').
182: ': <a href="'.$content{'attachmenturl'}.'"><tt>'.
183: $fname.'</tt></a>';
184: }
185: }
186: return %content;
187: }
188:
189: # ======================================================= Get info out of msgid
190:
191: sub buildmsgid {
192: my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_;
193: $subject=&escape($subject);
194: return(&escape($now.':'.$subject.':'.$uname.':'.
195: $udom.':'.$msgcount.':'.$course_context.':'.$pid.':'.$symb.':'.$error));
196: }
197:
198: sub unpackmsgid {
199: my ($msgid,$folder,$skipstatus,$status_cache)=@_;
200: $msgid=&unescape($msgid);
201: my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid,
202: $processid,$symb,$error) = split(/\:/,&unescape($msgid));
203: $shortsubj = &unescape($shortsubj);
204: $shortsubj = &HTML::Entities::decode($shortsubj);
205: if (!defined($processid)) { $fromcid = ''; }
206: my %status=();
207: unless ($skipstatus) {
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}=''; }
215: unless ($status{$msgid}) { $status{$msgid}='new'; }
216: }
217: return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid,$symb,$error);
218: }
219:
220:
221: sub sendemail {
222: my ($to,$subject,$body)=@_;
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: }
230: $body=
231: "*** ".&mt('This is an automatic message generated by the LON-CAPA system.')."\n".
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;
234: my $msg = new Mail::Send;
235: $msg->to($to);
236: $msg->subject('[LON-CAPA] '.$subject);
237: if ($senderaddress) { $msg->add('Reply-to',$senderaddress); $msg->add('From',$senderaddress); }
238: if (my $fh = $msg->open()) {
239: print $fh $body;
240: $fh->close;
241: }
242: }
243:
244: # ==================================================== Send notification emails
245:
246: sub sendnotification {
247: my ($to,$touname,$toudom,$subj,$crit,$text)=@_;
248: my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'};
249: unless ($sender=~/\w/) {
250: $sender=$env{'user.name'}.'@'.$env{'user.domain'};
251: }
252: my $critical=($crit?' critical':'');
253: $text=~s/\<\;/\</gs;
254: $text=~s/\>\;/\>/gs;
255: $text=~s/\<\/*[^\>]+\>//gs;
256: my $url='http://'.
257: $Apache::lonnet::hostname{&Apache::lonnet::homeserver($touname,$toudom)}.
258: '/adm/email?username='.$touname.'&domain='.$toudom;
259: my $body=(<<ENDMSG);
260: You received a$critical message from $sender in LON-CAPA. The subject is
261:
262: $subj
263:
264: === Excerpt ============================================================
265: $text
266: ========================================================================
267:
268: Use
269:
270: $url
271:
272: to access the full message.
273: ENDMSG
274: &sendemail($to,'New'.$critical.' message from '.$sender,$body);
275: }
276: # ============================================================= Check for email
277:
278: sub newmail {
279: if ((time-$env{'user.mailcheck.time'})>300) {
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:
287: # =============================== Automated message to the author of a resource
288:
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:
296: sub author_res_msg {
297: my ($filename,$message)=@_;
298: unless ($message) { return 'empty'; }
299: $filename=&Apache::lonnet::declutter($filename);
300: my ($domain,$author,@dummy)=split(/\//,$filename);
301: my $homeserver=&Apache::lonnet::homeserver($author,$domain);
302: if ($homeserver ne 'no_host') {
303: my $id=unpack("%32C*",$message);
304: $message .= " <p>This error occurred on machine ".
305: $Apache::lonnet::perlvar{'lonHostID'}."</p>";
306: my $msgid;
307: ($msgid,$message)=&packagemsg($filename,$message);
308: return &Apache::lonnet::reply('put:'.$domain.':'.$author.
309: ':nohist_res_msgs:'.
310: &escape($filename.'_'.$id).'='.
311: &escape($message),$homeserver);
312: }
313: return 'no_host';
314: }
315:
316: # =========================================== Retrieve author resource messages
317:
318: sub retrieve_author_res_msg {
319: my $url=shift;
320: $url=&Apache::lonnet::declutter($url);
321: my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
322: my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author);
323: my $msgs='';
324: foreach (keys %errormsgs) {
325: if ($_=~/^\Q$url\E\_\d+$/) {
326: my %content=&unpackagemsg($errormsgs{$_});
327: $msgs.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'.
328: $content{'time'}.'</b>: '.$content{'message'}.
329: '<br /></p>';
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 {
339: my $url=shift;
340: $url=&Apache::lonnet::declutter($url);
341: my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
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);
349: }
350: # =================================== Clear out all author messages in URL path
351:
352: sub clear_author_res_msg {
353: my $url=shift;
354: $url=&Apache::lonnet::declutter($url);
355: my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
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: }
364: # ================= Return hash with URLs for which there is a resource message
365:
366: sub all_url_author_res_msg {
367: my ($author,$domain)=@_;
368: my %returnhash=();
369: foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
370: $_=~/^(.+)\_\d+/;
371: $returnhash{$1}=1;
372: }
373: return %returnhash;
374: }
375:
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:
388: # ================================================== Critical message to a user
389:
390: sub user_crit_msg_raw {
391: my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_;
392: # Check if allowed missing
393: my ($status,$packed_message);
394: my $msgid='undefined';
395: unless (($message)&&($user)&&($domain)) { $status='empty'; };
396: my $text=$message;
397: my $homeserver=&Apache::lonnet::homeserver($user,$domain);
398: if ($homeserver ne 'no_host') {
399: ($msgid,$packed_message)=&packagemsg($subject,$message);
400: if ($sendback) { $packed_message.='<sendback>true</sendback>'; }
401: $status=&Apache::lonnet::critical(
402: 'put:'.$domain.':'.$user.':critical:'.
403: &escape($msgid).'='.
404: &escape($packed_message),$homeserver);
405: if (defined($sentmessage)) {
406: $$sentmessage = $packed_message;
407: }
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);
412: } else {
413: $status='no_host';
414: }
415:
416: # Notifications
417: my %userenv = &Apache::loncommon::getemails($user,$domain);
418: if ($userenv{'critnotification'}) {
419: &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1,
420: $text);
421: }
422: if ($toperm && $userenv{'permanentemail'}) {
423: &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1,
424: $text);
425: }
426: # Log this
427: &Apache::lonnet::logthis(
428: 'Sending critical email '.$msgid.
429: ', log status: '.
430: &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
431: $env{'user.home'},
432: 'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
433: .$status));
434: return $status;
435: }
436:
437: # New routine that respects "forward" and calls old routine
438:
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:
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:
453: =cut
454:
455: sub user_crit_msg {
456: my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_;
457: my @status;
458: my %userenv = &Apache::lonnet::get('environment',['msgforward'],
459: $domain,$user);
460: my $msgforward=$userenv{'msgforward'};
461: if ($msgforward) {
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));
467: }
468: } else {
469: push(@status,
470: &user_crit_msg_raw($user,$domain,$subject,$message,$sendback,
471: $toperm,$sentmessage));
472: }
473: if (wantarray) {
474: return @status;
475: }
476: return join(' ',@status);
477: }
478:
479: # =================================================== Critical message received
480:
481: sub user_crit_received {
482: my $msgid=shift;
483: my %message=&Apache::lonnet::get('critical',[$msgid]);
484: my %contents=&unpackagemsg($message{$msgid},1);
485: my $status='rec: '.($contents{'sendback'}?
486: &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
487: &mt('Receipt').': '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.', '.$contents{'subject'},
488: &mt('User').' '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.
489: ' acknowledged receipt of message'."\n".' "'.
490: $contents{'subject'}.'"'."\n".&mt('dated').' '.
491: $contents{'time'}.".\n"
492: ):'no msg req');
493: $status.=' trans: '.
494: &Apache::lonnet::put(
495: 'nohist_email',{$contents{'msgid'} => $message{$msgid}});
496: $status.=' del: '.
497: &Apache::lonnet::del('critical',[$contents{'msgid'}]);
498: &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
499: $env{'user.home'},'Received critical message '.
500: $contents{'msgid'}.
501: ', '.$status);
502: return $status;
503: }
504:
505: # ======================================================== Normal communication
506:
507: sub user_normal_msg_raw {
508: my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
509: $toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle,
510: $error)=@_;
511: # Check if allowed missing
512: my ($status,$packed_message);
513: my $msgid='undefined';
514: my $text=$message;
515: unless (($message)&&($user)&&($domain)) { $status='empty'; };
516: my $homeserver=&Apache::lonnet::homeserver($user,$domain);
517: if ($homeserver ne 'no_host') {
518: ($msgid,$packed_message)=
519: &packagemsg($subject,$message,$citation,$baseurl,
520: $attachmenturl,$user,$domain,$currid,
521: undef,$crsmsgid,$symb,$error);
522:
523: # Store in user folder
524: $status=&Apache::lonnet::critical(
525: 'put:'.$domain.':'.$user.':nohist_email:'.
526: &escape($msgid).'='.
527: &escape($packed_message),$homeserver);
528: # Save new message received time
529: &Apache::lonnet::put
530: ('email_status',{'recnewemail'=>time},$domain,$user);
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'})) &&
535: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
536: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
537: '/'.$env{'request.course.sec'})))) {
538: (undef,my $packed_message_no_citation) =
539: &packagemsg($subject,$message,undef,$baseurl,$attachmenturl,
540: $user,$domain,$currid,undef,$crsmsgid,$symb,$error);
541: $status .= &store_sent_mail($msgid,$packed_message_no_citation);
542: }
543: } else {
544: $status='no_host';
545: }
546: if (defined($newid)) {
547: $$newid = $msgid;
548: }
549: if (defined($sentmessage)) {
550: $$sentmessage = $packed_message;
551: }
552:
553: # Notifications
554: my %userenv = &Apache::lonnet::get('environment',['notification',
555: 'permanentemail'],
556: $domain,$user);
557: if ($userenv{'notification'}) {
558: &sendnotification($userenv{'notification'},$user,$domain,$subject,0,
559: $text);
560: }
561: if ($toperm && $userenv{'permanentemail'}) {
562: &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0,
563: $text);
564: }
565: &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
566: $env{'user.home'},
567: 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
568: return $status;
569: }
570:
571: # New routine that respects "forward" and calls old routine
572:
573: =pod
574:
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.
578:
579: =cut
580:
581: sub user_normal_msg {
582: my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
583: $toperm,$sentmessage,$symb,$restitle,$error)=@_;
584: my $status='';
585: my %userenv = &Apache::lonnet::get('environment',['msgforward'],
586: $domain,$user);
587: my $msgforward=$userenv{'msgforward'};
588: if ($msgforward) {
589: foreach (split(/\,/,$msgforward)) {
590: my ($forwuser,$forwdomain)=split(/\:/,$_);
591: $status.=
592: &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,
593: $citation,$baseurl,$attachmenturl,$toperm,
594: undef,undef,$sentmessage,undef,$symb,$restitle,$error).' ';
595: }
596: } else {
597: $status=&user_normal_msg_raw($user,$domain,$subject,$message,
598: $citation,$baseurl,$attachmenturl,$toperm,
599: undef,undef,$sentmessage,undef,$symb,$restitle,$error);
600: }
601: return $status;
602: }
603:
604: sub store_sent_mail {
605: my ($msgid,$message) = @_;
606: my $status =' '.&Apache::lonnet::critical(
607: 'put:'.$env{'user.domain'}.':'.$env{'user.name'}.
608: ':nohist_email_sent:'.
609: &escape($msgid).'='.
610: &escape($message),$env{'user.home'});
611: return $status;
612: }
613:
614: # =============================================================== Folder suffix
615:
616: sub foldersuffix {
617: my $folder=shift;
618: unless ($folder) { return ''; }
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;
644: }
645:
646: 1;
647: __END__
648:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>