--- loncom/interface/lonmsg.pm 2007/05/08 16:50:02 1.205 +++ loncom/interface/lonmsg.pm 2022/01/19 03:33:46 1.239.2.4 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Routines for messaging # -# $Id: lonmsg.pm,v 1.205 2007/05/08 16:50:02 raeburn Exp $ +# $Id: lonmsg.pm,v 1.239.2.4 2022/01/19 03:33:46 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,9 +53,148 @@ with Domain Coordinator e-mail for the storage of information about recipients of the message/e-mail. -=head1 FUNCTIONS +=head1 SUBROUTINES -=over 4 +=over + +=pod + +=item packagemsg() + +Package + +=item get_course_context() + +=item unpackagemsg() + +Unpack message into a hash + +=item buildmsgid() + +Get info out of msgid + +=item unpackmsgid() + +=item sendemail() + +=item sendnotification() + +Send notification emails + +=item newmail() + +Check for email + +=item author_res_msg() + +Automated message to the author of a resource + +=item * B: Sends message $message to the owner + of the resource with the URI $filename. + +=item retrieve_author_res_msg() + +Retrieve author resource messages + +=item del_url_author_res_msg() + +Delete all author messages related to one URL + +=item clear_author_res_msg() + +Clear out all author messages in URL path + +=item all_url_author_res_msg() + +Return hash with URLs for which there is a resource message + +=item store_instructor_comment() + +Add a comment to the User Notes screen + +=item user_crit_msg_raw() + +Critical message to a user + +=item user_crit_msg() + +New routine that respects "forward" and calls old routine + +=item * B: + Sends a critical message $message to the $user at $domain. If $sendback + is true, a receipt will be sent to the current user when $user receives + the message. + + Additionally it will check if the user has a Forwarding address + set, and send the message to that address instead + + returns + - in array context a list of results for each message that was sent + - in scalar context a space seperated list of results for each + message sent + + +=item user_crit_received() + +Critical message received + +=item user_normal_msg_raw() + +Normal communication + +=item user_normal_msg() + +New routine that respects "forward" and calls old routine + +=item * B: + Sends a message to the $user at $domain, with subject $subject and message $message. + + Additionally it will check if the user has a Forwarding address + set, and send the message to that address instead + + returns + - in array context a list of results for each message that was sent + - in scalar context a space seperated list of results for each + message sent + +=item store_sent_mail() + +=item store_recipients() + +=item foldersuffix() + +=item get_user_folders() + +User-defined folders + +=item secapply() + +=item B: + +Arguments + $feedurl - /res/ url of resource (only need if $author is true) + $author,$question,$course,$policy - all true/false parameters + if true will attempt to find the addresses of user that should receive + this type of feedback (author - feedback to author of resource $feedurl, + $question 'Resource Content Questions', $course 'Course Content Question', + $policy 'Course Policy') + (Additionally it also checks $env for whether the corresponding form. + element exists, for ease of use in a html response context) + + $defaultflag - (internal should be left blank) if true gather addresses + that aren't for a section even if I have a section + (used for reccursion internally, first we look for + addresses for our specific section then we recurse + and look for non section addresses) + +Returns + $typestyle - string of html text, describing what addresses were found + %to - a hash, which keys are addresses of users to send messages to + the keys will look like name:domain + +=back =cut @@ -64,6 +203,8 @@ use Apache::lonnet; use HTML::TokeParser(); use Apache::lonlocal; use Mail::Send; +use HTML::Entities; +use Encode; use LONCAPA qw(:DEFAULT :match); { @@ -74,22 +215,39 @@ use LONCAPA qw(:DEFAULT :match); } } -# ===================================================================== Package + sub packagemsg { - my ($subject,$message,$citation,$baseurl,$attachmenturl, - $recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error,$recipid)=@_; + my ($subject,$message,$citation,$baseurl,$attachmenturl,$recuser,$recdomain, + $msgid,$type,$crsmsgid,$symb,$error,$recipid,$senthide,$origmsgid)=@_; $message =&HTML::Entities::encode($message,'<>&"'); $citation=&HTML::Entities::encode($citation,'<>&"'); $subject =&HTML::Entities::encode($subject,'<>&"'); #remove machine specification - $baseurl =~ s|^http://[^/]+/|/|; + $baseurl =~ s|^https?://[^/]+/|/|; $baseurl =&HTML::Entities::encode($baseurl,'<>&"'); #remove machine specification - $attachmenturl =~ s|^http://[^/]+/|/|; + $attachmenturl =~ s|^https?://[^/]+/|/|; $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"'); + if ($senthide) { + foreach my $item ($subject,$message) { + if ($item ne '') { + $item = 'Not shown due to IP block'; + } + } + if ($attachmenturl ne '') { + $attachmenturl = ''; + } + if ($citation ne '') { + $citation = ''; + } + if ($msgid ne '') { + $msgid = ''; + } + } my $course_context = &get_course_context(); my $now=time; + my $ip = &Apache::lonnet::get_requestor_ip(); my $msgcount = &get_uniq(); unless(defined($msgid)) { $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'}, @@ -109,7 +267,7 @@ sub packagemsg { } $result .= ''.$ENV{'SERVER_NAME'}.''. ''.$ENV{'HTTP_HOST'}.''. - ''.$ENV{'REMOTE_ADDR'}.''. + ''.$ip.''. ''.$env{'browser.type'}.''. ''.$env{'browser.os'}.''. ''.$env{'browser.version'}.''. @@ -120,6 +278,9 @@ sub packagemsg { ''.$env{'request.role'}.''. ''.$env{'request.filename'}.''. ''.$msgid.''; + if (defined($env{'form.group'})) { + $result .= ''.$env{'form.group'}.''; + } if (ref($recuser) eq 'ARRAY') { for (my $i=0; $i<@{$recuser}; $i++) { if ($type eq 'dcmail') { @@ -174,14 +335,25 @@ sub packagemsg { } } } + if ($senthide) { + $result .= '$origmsgid'; + } return ($msgid,$result); } sub get_course_context { my $course_context; + my $msgkey; if (defined($env{'form.replyid'})) { + $msgkey = $env{'form.replyid'}; + } elsif (defined($env{'form.forwid'})) { + $msgkey = $env{'form.forwid'} + } elsif (defined($env{'form.multiforwid'})) { + $msgkey = $env{'form.multiforwid'}; + } + if ($msgkey ne '') { my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)= - split(/\:/,&unescape($env{'form.replyid'})); + split(/\:/,&unescape($msgkey)); $course_context = $origcid; } foreach my $key (keys(%env)) { @@ -198,10 +370,9 @@ sub get_course_context { return $course_context; } -# ================================================== Unpack message into a hash sub unpackagemsg { - my ($message,$notoken)=@_; + my ($message,$notoken,$noattachmentlink)=@_; my %content=(); my $parser=HTML::TokeParser->new(\$message); my $token; @@ -221,7 +392,7 @@ sub unpackagemsg { } } if (!exists($content{'recuser'})) { $content{'recuser'} = []; } - if ($content{'attachmenturl'}) { + if (($content{'attachmenturl'}) && (!$noattachmentlink)) { my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|); if ($notoken) { $content{'message'}.='

'.&mt('Attachment').': '.$fname.''; @@ -236,7 +407,6 @@ sub unpackagemsg { return %content; } -# ======================================================= Get info out of msgid sub buildmsgid { my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_; @@ -247,10 +417,14 @@ sub buildmsgid { } sub unpackmsgid { - my ($msgid,$folder,$skipstatus,$status_cache)=@_; + my ($msgid,$folder,$skipstatus,$status_cache,$onlycid)=@_; $msgid=&unescape($msgid); my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid, $processid,$symb,$error) = split(/\:/,&unescape($msgid)); + if (!defined($processid)) { $fromcid = ''; } + if (($onlycid) && ($onlycid ne $fromcid)) { + return ($sendtime,'',$fromname,$fromdomain,'',$fromcid,'',$error); + } $shortsubj = &unescape($shortsubj); $shortsubj = &HTML::Entities::decode($shortsubj); $symb = &unescape($symb); @@ -271,26 +445,58 @@ sub unpackmsgid { sub sendemail { - my ($to,$subject,$body)=@_; - my %senderemails=&Apache::loncommon::getemails(); + my ($to,$subject,$body,$to_uname,$to_udom,$user_lh)=@_; my $senderaddress=''; - foreach my $type ('notification','permanentemail','critnotification') { - if ($senderemails{$type}) { - $senderaddress=$senderemails{$type}; - } + my $replytoaddress=''; + my $msgsent; + if ($env{'form.can_reply'} eq 'N') { + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + my $hostname = &Apache::lonnet::hostname($lonhost); + $replytoaddress = 'do-not-reply@'.$hostname; + } else { + my %senderemails; + my $have_sender; + if ($env{'form.reply_to_addr'}) { + my ($replytoname,$replytodom) = split(/:/,$env{'form.reply_to_addr'}); + if (!($replytoname eq $env{'user.name'} && $replytodom eq $env{'user.domain'})) { + if (&Apache::lonnet::homeserver($replytoname,$replytodom) ne 'no_host') { + %senderemails = + &Apache::loncommon::getemails($replytoname,$replytodom); + $have_sender = 1; + } + } + } + if (!$have_sender) { + %senderemails=&Apache::loncommon::getemails(); + } + foreach my $type ('permanentemail','critnotification','notification') { + if ($senderemails{$type}) { + ($senderaddress) = split(/,/,$senderemails{$type}); + last if ($senderaddress); + } + } } $body= - "*** ".&mt('This is an automatic message generated by the LON-CAPA system.')."\n". - "*** ".($senderaddress?&mt('You can reply to this message'):&mt('Please do not reply to this address.')."\n*** ". - &mt('A reply will not be received by the recipient!'))."\n\n".$body; + "*** ".&mt_user($user_lh,'This is an automatic e-mail generated by the LON-CAPA system.')."\n". + "*** ".($senderaddress?&mt_user($user_lh,'You can reply to this e-mail'):&mt_user($user_lh,'Please do not reply to this address.')."\n*** ". + &mt_user($user_lh,'A reply will not be received by the recipient!'))."\n\n".$body; + my $msg = new Mail::Send; $msg->to($to); $msg->subject('[LON-CAPA] '.$subject); - if ($senderaddress) { $msg->add('Reply-to',$senderaddress); $msg->add('From',$senderaddress); } + if ($replytoaddress) { + $msg->add('Reply-to',$replytoaddress); + } + if ($senderaddress) { + $msg->add('From',$senderaddress); + } + $msg->add('Content-type','text/plain; charset=UTF-8'); if (my $fh = $msg->open()) { print $fh $body; $fh->close; + $msgsent = 1; } + return $msgsent; } # ==================================================== Send notification emails @@ -299,20 +505,25 @@ sub sendnotification { my ($to,$touname,$toudom,$subj,$crit,$text,$msgid)=@_; my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'}; unless ($sender=~/\w/) { - $sender=$env{'user.name'}.'@'.$env{'user.domain'}; + $sender=$env{'user.name'}.':'.$env{'user.domain'}; } my $critical=($crit?' critical':''); + my $numsent = 0; + $text=~s/\<\;/\/gs; - $text=~s/\<\/*[^\>]+\>//gs; - my $url='http://'. - &Apache::lonnet::hostname(&Apache::lonnet::homeserver($touname,$toudom)). - '/adm/email?username='.$touname.'&domain='.$toudom; + my $homeserver = &Apache::lonnet::homeserver($touname,$toudom); + my $protocol = $Apache::lonnet::protocol{$homeserver}; + $protocol = 'http' if ($protocol ne 'https'); + my $url = $protocol.'://'.&Apache::lonnet::hostname($homeserver). + '/adm/email?username='.$touname.'&domain='.$toudom. + '&display='.&escape($msgid); my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid, $symb,$error) = &Apache::lonmsg::unpackmsgid($msgid); - my $coursetext; + my ($coursetext,$body,$bodybegin,$bodysubj,$bodyend); + my $user_lh = &Apache::loncommon::user_lang($touname,$toudom,$fromcid); if ($fromcid ne '') { - $coursetext = "\n".&mt('Course').': '; + $coursetext = "\n".&mt_user($user_lh,'Course').': '; if ($env{'course.'.$fromcid.'.description'} ne '') { $coursetext .= $env{'course.'.$fromcid.'.description'}; } else { @@ -323,42 +534,105 @@ sub sendnotification { } $coursetext .= "\n\n"; } - my $body = $coursetext. - &mt('You received a'.$critical.' message from [_1] in LON-CAPA.',$sender).' '.&mt('The subject is + my @recipients = split(/,/,$to); + $bodybegin = $coursetext. + &mt_user($user_lh, + 'You received a'.$critical.' message from [_1] in LON-CAPA.',$sender).' '; + $bodysubj = &mt_user($user_lh,'The subject is [_1] ',$subj)."\n". -'=== '.&mt('Excerpt')." ============================================================ -$text +'=== '.&mt_user($user_lh,'Excerpt')." ============================================================ +"; + $bodyend = " ======================================================================== -".&mt('Use +".&mt_user($user_lh,'Use [_1] to access the full message.',$url); - &sendemail($to,'New'.$critical.' message from '.$sender,$body); + my %userenv = &Apache::lonnet::get('environment',['notifywithhtml'],$toudom,$touname); + my $subject = &mt_user($user_lh,"'New'$critical message from [_1]",$sender); + unless ($subj eq '') { + $subject = $subj; + } + + my ($blocked,$blocktext,$clientip); + $clientip = &Apache::lonnet::get_requestor_ip(); + if (!$crit) { + my %setters; + my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = + &Apache::loncommon::blockcheck(\%setters,'com',$clientip,$touname,$toudom); + if ($startblock && $endblock) { + $blocked = 1; + my $showstart = &Apache::lonlocal::locallocaltime($startblock); + my $showend = &Apache::lonlocal::locallocaltime($endblock); + $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); + } elsif ($by_ip) { + $blocked = 1; + $blocktext = &mt_user($user_lh,'LON-CAPA messages sent to you will be inaccessible from your IP address [_1], because communication is being blocked for certain IP address(es).',$clientip); + } + } + if ($userenv{'notifywithhtml'} ne '') { + my @htmlexcerpt = split(/,/,$userenv{'notifywithhtml'}); + my $htmlfree = &make_htmlfree($text); + foreach my $addr (@recipients) { + if ($blocked) { + $body = $bodybegin."\n".$blocktext."\n".$bodyend; + } else { + my $sendtext; + if (!grep/^\Q$addr\E/,@htmlexcerpt) { + $sendtext = $htmlfree; + } else { + $sendtext = $text; + } + $body = $bodybegin.$bodysubj.$sendtext.$bodyend; + } + if (&sendemail($addr,$subject,$body,$touname,$toudom,$user_lh)) { + $numsent ++; + } + } + } else { + if ($blocked) { + $body = $bodybegin."\n".$blocktext."\n".$bodyend; + } else { + my $htmlfree = &make_htmlfree($text); + $body = $bodybegin.$bodysubj.$htmlfree.$bodyend; + } + if (&sendemail($to,$subject,$body,$touname,$toudom,$user_lh)) { + $numsent ++; + } + } + return $numsent; +} + +sub make_htmlfree { + my ($text) = @_; + $text =~ s/\<\/*[^\>]+\>//gs; + $text = &HTML::Entities::decode($text); + $text = &Encode::encode('utf8',$text); + return $text; +} + +sub mynewmail{ + &newmail(); + return $env{'user.mailcheck.lastnewmessagetime'} > $env{'user.mailcheck.lastvisit'}; } -# ============================================================= Check for email + sub newmail { if ((time-$env{'user.mailcheck.time'})>300) { my %what=&Apache::lonnet::get('email_status',['recnewemail']); - &Apache::lonnet::appenv('user.mailcheck.time'=>time); + &Apache::lonnet::appenv({'user.mailcheck.time'=>time}); + &Apache::lonnet::appenv({'user.mailcheck.lastnewmessagetime'=> $what{'recnewemail'}}); if ($what{'recnewemail'}>0) { return 1; } } return 0; } -# =============================== Automated message to the author of a resource - -=pod - -=item * B: Sends message $message to the owner - of the resource with the URI $filename. -=cut sub author_res_msg { my ($filename,$message)=@_; @@ -380,7 +654,7 @@ sub author_res_msg { return 'no_host'; } -# =========================================== Retrieve author resource messages + sub retrieve_author_res_msg { my $url=shift; @@ -388,9 +662,9 @@ sub retrieve_author_res_msg { my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author); my $msgs=''; - foreach (keys %errormsgs) { - if ($_=~/^\Q$url\E\_\d+$/) { - my %content=&unpackagemsg($errormsgs{$_}); + foreach my $msg (keys(%errormsgs)) { + if ($msg =~ /^\Q$url\E\_\d+$/) { + my %content=&unpackagemsg($errormsgs{$msg}); $msgs.='

'. $content{'time'}.': '.$content{'message'}. '

'; @@ -400,47 +674,48 @@ sub retrieve_author_res_msg { } -# =============================== Delete all author messages related to one URL + + sub del_url_author_res_msg { my $url=shift; $url=&Apache::lonnet::declutter($url); my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); my @delmsgs=(); - foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { - if ($_=~/^\Q$url\E\_\d+$/) { - push (@delmsgs,$_); + foreach my $msg (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { + if ($msg =~ /^\Q$url\E\_\d+$/) { + push (@delmsgs,$msg); } } return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); } -# =================================== Clear out all author messages in URL path + sub clear_author_res_msg { my $url=shift; $url=&Apache::lonnet::declutter($url); my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); my @delmsgs=(); - foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { - if ($_=~/^\Q$url\E/) { - push (@delmsgs,$_); + foreach my $msg (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { + if ($msg =~ /^\Q$url\E/) { + push (@delmsgs,$msg); } } return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); } -# ================= Return hash with URLs for which there is a resource message + + sub all_url_author_res_msg { my ($author,$domain)=@_; my %returnhash=(); - foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { - $_=~/^(.+)\_\d+/; + foreach my $msg (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { + $msg =~ /^(.+)\_\d+/; $returnhash{$1}=1; } return %returnhash; } -# ====================================== Add a comment to the User Notes screen sub store_instructor_comment { my ($msg,$uname,$udom) = @_; @@ -455,11 +730,10 @@ sub store_instructor_comment { return $result; } -# ================================================== Critical message to a user sub user_crit_msg_raw { my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage, - $nosentstore,$recipid)=@_; + $nosentstore,$recipid,$attachmenturl,$permresults,$senthide)=@_; # Check if allowed missing my ($status,$packed_message); my $msgid='undefined'; @@ -468,22 +742,24 @@ sub user_crit_msg_raw { my $homeserver=&Apache::lonnet::homeserver($user,$domain); if ($homeserver ne 'no_host') { ($msgid,$packed_message)=&packagemsg($subject,$message,undef,undef, - undef,undef,undef,undef,undef,undef,undef, - undef,$recipid); + $attachmenturl,undef,undef,undef,undef,undef, + undef,undef,$recipid); if ($sendback) { $packed_message.='true'; } - $status=&Apache::lonnet::critical( - 'put:'.$domain.':'.$user.':critical:'. - &escape($msgid).'='. - &escape($packed_message),$homeserver); + $status=&Apache::lonnet::cput('critical', {$msgid => $packed_message}, + $domain,$user); if (defined($sentmessage)) { $$sentmessage = $packed_message; } if (!$nosentstore) { - (undef,my $packed_message_no_citation) = - &packagemsg($subject,$message,undef,undef,undef,$user,$domain, - $msgid); + my ($sentmsgid,$packed_message_no_citation) = + &packagemsg($subject,$message,undef,undef,$attachmenturl,$user, + $domain,$msgid,undef,undef,undef,undef,undef,$senthide,$msgid); if ($status eq 'ok' || $status eq 'con_delayed') { - &store_sent_mail($msgid,$packed_message_no_citation); + if ($senthide && $sentmsgid) { + &store_sent_mail($sentmsgid,$packed_message_no_citation); + } else { + &store_sent_mail($msgid,$packed_message_no_citation); + } } } } else { @@ -492,47 +768,48 @@ sub user_crit_msg_raw { # Notifications my %userenv = &Apache::loncommon::getemails($user,$domain); - if ($userenv{'critnotification'}) { - &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1, - $text,$msgid); - } - if ($toperm && $userenv{'permanentemail'}) { - &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1, - $text,$msgid); + my $critnotify = $userenv{'critnotification'}; + my $permemail = $userenv{'permanentemail'}; + my $numcrit = 0; + my $numperm = 0; + my $permlogmsgstatus; + if ($critnotify) { + $numcrit = &sendnotification($critnotify,$user,$domain,$subject,1,$text,$msgid); + } + if ($toperm && $permemail) { + if ($critnotify && $numcrit) { + if (grep(/^\Q$permemail\E/,split(/,/,$critnotify))) { + $numperm = 1; + } + } + unless ($numperm) { + $numperm = &sendnotification($permemail,$user,$domain,$subject,1,$text,$msgid); + } + } + if ($toperm) { + $permlogmsgstatus = '. Perm. email log status '. + &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},$env{'user.home'}, + "Perm. e-mail count $numperm for $user at $domain"); + if (ref($permresults) eq 'HASH') { + $permresults->{"$user:$domain"} = $numperm; + } } # Log this &Apache::lonnet::logthis( - 'Sending critical email '.$msgid. + 'Sending critical '.$msgid. ', log status: '. &Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, $env{'user.home'}, - 'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: ' - .$status)); + 'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status ' + .$status).$permlogmsgstatus); return $status; } -# New routine that respects "forward" and calls old routine - -=pod - -=item * B: - Sends a critical message $message to the $user at $domain. If $sendback - is true, a receipt will be sent to the current user when $user receives - the message. - - Additionally it will check if the user has a Forwarding address - set, and send the message to that address instead - returns - - in array context a list of results for each message that was sent - - in scalar context a space seperated list of results for each - message sent - -=cut sub user_crit_msg { my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage, - $nosentstore,$recipid)=@_; + $nosentstore,$recipid,$attachmenturl,$permresults,$senthide)=@_; my @status; my %userenv = &Apache::lonnet::get('environment',['msgforward'], $domain,$user); @@ -543,12 +820,13 @@ sub user_crit_msg { push(@status, &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message, $sendback,$toperm,$sentmessage,$nosentstore, - $recipid)); + $recipid,$attachmenturl,$permresults,$senthide)); } } else { push(@status, &user_crit_msg_raw($user,$domain,$subject,$message,$sendback, - $toperm,$sentmessage,$nosentstore,$recipid)); + $toperm,$sentmessage,$nosentstore,$recipid, + $attachmenturl,$permresults,$senthide)); } if (wantarray) { return @status; @@ -556,7 +834,6 @@ sub user_crit_msg { return join(' ',@status); } -# =================================================== Critical message received sub user_crit_received { my $msgid=shift; @@ -592,12 +869,13 @@ sub user_crit_received { return $status; } -# ======================================================== Normal communication + + sub user_normal_msg_raw { my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, $toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle, - $error,$nosentstore,$recipid)=@_; + $error,$nosentstore,$recipid,$permresults,$senthide)=@_; # Check if allowed missing my ($status,$packed_message); my $msgid='undefined'; @@ -611,20 +889,24 @@ sub user_normal_msg_raw { undef,$crsmsgid,$symb,$error,$recipid); # Store in user folder - $status=&Apache::lonnet::critical( - 'put:'.$domain.':'.$user.':nohist_email:'. - &escape($msgid).'='. - &escape($packed_message),$homeserver); + $status= + &Apache::lonnet::cput('nohist_email',{$msgid => $packed_message}, + $domain,$user); # Save new message received time &Apache::lonnet::put ('email_status',{'recnewemail'=>time},$domain,$user); # Into sent-mail folder if sent mail storage required if (!$nosentstore) { - (undef,my $packed_message_no_citation) = + my ($sentmsgid,$packed_message_no_citation) = &packagemsg($subject,$message,undef,$baseurl,$attachmenturl, - $user,$domain,$currid,undef,$crsmsgid,$symb,$error); + $user,$domain,$currid,undef,$crsmsgid,$symb,$error, + undef,$senthide,$msgid); if ($status eq 'ok' || $status eq 'con_delayed') { - &store_sent_mail($msgid,$packed_message_no_citation); + if ($senthide && $sentmsgid) { + &store_sent_mail($sentmsgid,$packed_message_no_citation); + } else { + &store_sent_mail($msgid,$packed_message_no_citation); + } } } if (ref($newid) eq 'SCALAR') { @@ -634,66 +916,68 @@ sub user_normal_msg_raw { $$sentmessage = $packed_message; } # Notifications - my %userenv = &Apache::lonnet::get('environment',['notification', - 'permanentemail'], - $domain,$user); - if ($userenv{'notification'}) { - &sendnotification($userenv{'notification'},$user,$domain,$subject,0, - $text,$msgid); + my %userenv = &Apache::loncommon::getemails($user,$domain); + my $notify = $userenv{'notification'}; + my $permemail = $userenv{'permanentemail'}; + my $numnotify = 0; + my $numperm = 0; + my $permlogmsgstatus; + if ($notify) { + $numnotify = &sendnotification($notify,$user,$domain,$subject,0,$text,$msgid); } - if ($toperm && $userenv{'permanentemail'}) { - &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0, - $text,$msgid); + if ($toperm && $permemail) { + if ($notify && $numnotify) { + if (grep(/^\Q$permemail\E/,split(/,/,$notify))) { + $numperm = 1; + } + } + unless ($numperm) { + $numperm = &sendnotification($permemail,$user,$domain,$subject,0, + $text,$msgid); + } + } + if ($toperm) { + $permlogmsgstatus = '. Perm. email log status '. + &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},$env{'user.home'}, + "Perm. e-mail count $numperm for $user at $domain"); + if (ref($permresults) eq 'HASH') { + $permresults->{"$user:$domain"} = $numperm; + } } &Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, $env{'user.home'}, - 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status); + 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status '.$status. + $permlogmsgstatus); } else { $status='no_host'; } return $status; } -# New routine that respects "forward" and calls old routine - -=pod - -=item * B: - Sends a message to the $user at $domain, with subject $subject and message $message. - - Additionally it will check if the user has a Forwarding address - set, and send the message to that address instead - - returns - - in array context a list of results for each message that was sent - - in scalar context a space seperated list of results for each - message sent - -=cut - sub user_normal_msg { my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, - $toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid)=@_; + $toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid, + $permresults,$senthide)=@_; my @status; my %userenv = &Apache::lonnet::get('environment',['msgforward'], $domain,$user); my $msgforward=$userenv{'msgforward'}; if ($msgforward) { - foreach (split(/\,/,$msgforward)) { - my ($forwuser,$forwdomain)=split(/\:/,$_); + foreach my $fwd (split(/\,/,$msgforward)) { + my ($forwuser,$forwdomain)=split(/\:/,$fwd); push(@status, &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message, $citation,$baseurl,$attachmenturl,$toperm, undef,undef,$sentmessage,undef,$symb, - $restitle,$error,$nosentstore,$recipid)); + $restitle,$error,$nosentstore,$recipid, + $permresults,$senthide)); } } else { push(@status,&user_normal_msg_raw($user,$domain,$subject,$message, $citation,$baseurl,$attachmenturl,$toperm, undef,undef,$sentmessage,undef,$symb, - $restitle,$error,$nosentstore,$recipid)); + $restitle,$error,$nosentstore,$recipid, + $permresults,$senthide)); } if (wantarray) { return @status; @@ -702,7 +986,9 @@ sub user_normal_msg { } sub process_sent_mail { - my ($msgsubj,$subj_prefix,$numsent,$stamp,$msgname,$msgdom,$msgcount,$context,$pid,$savemsg,$recusers,$recudoms,$baseurl,$attachmenturl,$symb,$error,$senderuname,$senderdom,$senderhome) = @_; + my ($msgsubj,$subj_prefix,$numsent,$stamp,$msgname,$msgdom,$msgcount, + $context,$pid,$savemsg,$recusers,$recudoms,$baseurl,$attachmenturl, + $symb,$error,$senderuname,$senderdom,$recipid) = @_; my $sentsubj; if ($numsent > 1) { $sentsubj = $subj_prefix.' ('.$numsent.' sent) '.$msgsubj; @@ -717,26 +1003,23 @@ sub process_sent_mail { &buildmsgid($stamp,$sentsubj,$msgname,$msgdom,$msgcount,$context,$pid); (undef,my $sentmessage) = &packagemsg($msgsubj,$savemsg,undef,$baseurl,$attachmenturl,$recusers, - $recudoms,$sentmsgid,undef,undef,$symb,$error); + $recudoms,$sentmsgid,undef,undef,$symb,$error,$recipid); my $status = &store_sent_mail($sentmsgid,$sentmessage,$senderuname, - $senderdom,$senderhome); + $senderdom); return $status; } sub store_sent_mail { - my ($msgid,$message,$senderuname,$senderdom,$senderhome) = @_; + my ($msgid,$message,$senderuname,$senderdom) = @_; if ($senderuname eq '') { $senderuname = $env{'user.name'}; } if ($senderdom eq '') { $senderdom = $env{'user.domain'}; } - if ($senderhome eq '') { - $senderhome = $env{'user.home'}; - } - my $status =' '.&Apache::lonnet::critical( - 'put:'.$senderdom.':'.$senderuname.':nohist_email_sent:'. - &escape($msgid).'='.&escape($message),$senderhome); + my $status =' '.&Apache::lonnet::cput('nohist_email_sent', + {$msgid => $message}, + $senderdom,$senderuname); return $status; } @@ -759,7 +1042,6 @@ sub store_recipients { } } -# =============================================================== Folder suffix sub foldersuffix { my $folder=shift; @@ -774,7 +1056,6 @@ sub foldersuffix { return $suffix; } -# ========================================================= User-defined folders sub get_user_folders { my ($folder) = @_; @@ -795,7 +1076,9 @@ sub secapply { my $rec=shift; my $defaultflag=shift; $rec=~s/\s+//g; - $rec=~s/\@/\:/g; + unless ($rec =~ /\:/) { + $rec=~s/\@/\:/g; + } my ($adr,$sections_or_groups)=($rec=~/^([^\(]+)\(([^\)]+)\)/); if ($sections_or_groups) { foreach my $item (split(/\;/,$sections_or_groups)) { @@ -815,33 +1098,6 @@ sub secapply { return ''; } -=pod - -=item * B: - -Arguments - $feedurl - /res/ url of resource (only need if $author is true) - $author,$question,$course,$policy - all true/false parameters - if true will attempt to find the addresses of user that should receive - this type of feedback (author - feedback to author of resource $feedurl, - $question 'Resource Content Questions', $course 'Course Content Question', - $policy 'Course Policy') - (Additionally it also checks $env for whether the corresponding form. - element exists, for ease of use in a html response context) - - $defaultflag - (internal should be left blank) if true gather addresses - that aren't for a section even if I have a section - (used for reccursion internally, first we look for - addresses for our specific section then we recurse - and look for non section addresses) - -Returns - $typestyle - string of html text, describing what addresses were found - %to - a hash, which keys are addresses of users to send messages to - the keys will look like name:domain - -=cut - sub decide_receiver { my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_; &Apache::lonenc::check_decrypt(\$feedurl); @@ -881,12 +1137,6 @@ sub decide_receiver { return ($typestyle,%to); } -=pod - -=back - -=cut - 1; __END__