--- loncom/interface/lonmsg.pm 2009/01/04 16:21:10 1.214.2.4 +++ loncom/interface/lonmsg.pm 2022/01/18 17:33:13 1.248 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Routines for messaging # -# $Id: lonmsg.pm,v 1.214.2.4 2009/01/04 16:21:10 raeburn Exp $ +# $Id: lonmsg.pm,v 1.248 2022/01/18 17:33:13 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,17 +53,158 @@ 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 use strict; use Apache::lonnet; +use Apache::loncommon; 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|^https?\://[^/]+/|/|; + $baseurl =~ s|^https?://[^/]+/|/|; $baseurl =&HTML::Entities::encode($baseurl,'<>&"'); #remove machine specification - $attachmenturl =~ s|^https?\://[^/]+/|/|; + $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'}.''. @@ -177,6 +335,9 @@ sub packagemsg { } } } + if ($senthide) { + $result .= '$origmsgid'; + } return ($msgid,$result); } @@ -209,7 +370,6 @@ sub get_course_context { return $course_context; } -# ================================================== Unpack message into a hash sub unpackagemsg { my ($message,$notoken,$noattachmentlink)=@_; @@ -247,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) = @_; @@ -258,14 +417,17 @@ 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); - if (!defined($processid)) { $fromcid = ''; } my %status=(); unless ($skipstatus) { if (ref($status_cache)) { @@ -282,9 +444,10 @@ sub unpackmsgid { sub sendemail { - my ($to,$subject,$body,$to_uname,$to_udom,$user_lh)=@_; + my ($to,$subject,$body,$to_uname,$to_udom,$user_lh,$attachmenturl)=@_; my $senderaddress=''; my $replytoaddress=''; + my $msgsent; if ($env{'form.can_reply'} eq 'N') { my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; my $hostname = &Apache::lonnet::hostname($lonhost); @@ -306,52 +469,59 @@ sub sendemail { %senderemails=&Apache::loncommon::getemails(); } foreach my $type ('permanentemail','critnotification','notification') { - if ($senderemails{$type}) { + if ($senderemails{$type}) { ($senderaddress) = split(/,/,$senderemails{$type}); last if ($senderaddress); - } + } } } $body= - "*** ".&mt_user($user_lh,'This is an automatic message generated by the LON-CAPA system.')."\n". - "*** ".($senderaddress?&mt_user($user_lh,'You can reply to this message'):&mt_user($user_lh,'Please do not reply to this address.')."\n*** ". + "*** ".&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 ($replytoaddress) { - $msg->add('Reply-to',$replytoaddress); - } - if ($senderaddress) { - $msg->add('From',$senderaddress); - } - if (my $fh = $msg->open()) { - print $fh $body; - $fh->close; + + $attachmenturl = &Apache::lonnet::filelocation("",$attachmenturl); + my $filesize = (stat($attachmenturl))[7]; + if ($filesize > 1048576) { + # Don't send if it exceeds 1 MB. + print '

' + .&mt('Email not sent. Attachment exceeds permitted length.') + .'

'; + } else { + # Otherwise build and send the email + $subject = '[LON-CAPA] '.$subject; + &Apache::loncommon::mime_email($senderaddress,$replytoaddress,$to, + $subject,$body,'','',$attachmenturl,'',''); + $msgsent = 1; } + return $msgsent; } # ==================================================== Send notification emails sub sendnotification { - my ($to,$touname,$toudom,$subj,$crit,$text,$msgid)=@_; + my ($to,$touname,$toudom,$subj,$crit,$text,$msgid,$attachmenturl)=@_; my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'}; unless ($sender=~/\w/) { $sender=$env{'user.name'}.':'.$env{'user.domain'}; } my $critical=($crit?' critical':''); + my $numsent = 0; $text=~s/\<\;/\/gs; my $homeserver = &Apache::lonnet::homeserver($touname,$toudom); + my $hostname = &Apache::lonnet::hostname($homeserver); 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; +#FIXME + my $url = $protocol.'://'.$hostname. + '/adm/email?username='.$touname.'&domain='.$toudom. + '&display='.&escape($msgid); my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid, $symb,$error) = &Apache::lonmsg::unpackmsgid($msgid); my ($coursetext,$body,$bodybegin,$bodysubj,$bodyend); - my $user_lh = &user_lang($touname,$toudom,$fromcid); + my $user_lh = &Apache::loncommon::user_lang($touname,$toudom,$fromcid); if ($fromcid ne '') { $coursetext = "\n".&mt_user($user_lh,'Course').': '; if ($env{'course.'.$fromcid.'.description'} ne '') { @@ -384,63 +554,85 @@ sub sendnotification { to access the full message.',$url); my %userenv = &Apache::lonnet::get('environment',['notifywithhtml'],$toudom,$touname); - my $subject = &mt_user($user_lh,"'New' $critical message from ").$sender; + my $subject = &mt_user($user_lh,"'New'$critical message from [_1]",$sender); + unless ($subj eq '') { + $subject = $subj; + } - my ($blocked,$blocktext); + my ($blocked,$blocktext,$clientip); + $clientip = &Apache::lonnet::get_requestor_ip(); if (!$crit) { my %setters; - my ($startblock,$endblock) = - &Apache::loncommon::blockcheck(\%setters,'com',$touname,$toudom); + 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 = $text; + my $sendtext; if (!grep/^\Q$addr\E/,@htmlexcerpt) { - $sendtext =~ s/\<\/*[^\>]+\>//gs; + $sendtext = $htmlfree; + } else { + $sendtext = $text; } $body = $bodybegin.$bodysubj.$sendtext.$bodyend; } - &sendemail($addr,$subject,$body,$touname,$toudom,$user_lh); + if (&sendemail($addr,$subject,$body,$touname,$toudom,$user_lh,$attachmenturl)) { + $numsent ++; + } } } else { if ($blocked) { $body = $bodybegin."\n".$blocktext."\n".$bodyend; } else { - $text =~ s/\<\/*[^\>]+\>//gs; - $body = $bodybegin.$bodysubj.$text.$bodyend; + my $htmlfree = &make_htmlfree($text); + $body = $bodybegin.$bodysubj.$htmlfree.$bodyend; + } + if (&sendemail($to,$subject,$body,$touname,$toudom,$user_lh,$attachmenturl)) { + $numsent ++; } - &sendemail($to,$subject,$body,$touname,$toudom,$user_lh); } + 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.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)=@_; @@ -462,7 +654,7 @@ sub author_res_msg { return 'no_host'; } -# =========================================== Retrieve author resource messages + sub retrieve_author_res_msg { my $url=shift; @@ -470,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'}. '

'; @@ -482,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) = @_; @@ -537,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,$attachmenturl)=@_; + $nosentstore,$recipid,$attachmenturl,$permresults,$senthide)=@_; # Check if allowed missing my ($status,$packed_message); my $msgid='undefined'; @@ -559,11 +751,15 @@ sub user_crit_msg_raw { $$sentmessage = $packed_message; } if (!$nosentstore) { - (undef,my $packed_message_no_citation) = + my ($sentmsgid,$packed_message_no_citation) = &packagemsg($subject,$message,undef,undef,$attachmenturl,$user, - $domain,$msgid); + $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 { @@ -572,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,$attachmenturl); + } + 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,$attachmenturl); + } + } + 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,$attachmenturl)=@_; + $nosentstore,$recipid,$attachmenturl,$permresults,$senthide)=@_; my @status; my %userenv = &Apache::lonnet::get('environment',['msgforward'], $domain,$user); @@ -623,13 +820,13 @@ sub user_crit_msg { push(@status, &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message, $sendback,$toperm,$sentmessage,$nosentstore, - $recipid,$attachmenturl)); + $recipid,$attachmenturl,$permresults,$senthide)); } } else { push(@status, &user_crit_msg_raw($user,$domain,$subject,$message,$sendback, $toperm,$sentmessage,$nosentstore,$recipid, - $attachmenturl)); + $attachmenturl,$permresults,$senthide)); } if (wantarray) { return @status; @@ -637,7 +834,6 @@ sub user_crit_msg { return join(' ',@status); } -# =================================================== Critical message received sub user_crit_received { my $msgid=shift; @@ -673,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'; @@ -700,11 +897,16 @@ sub user_normal_msg_raw { ('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') { @@ -715,65 +917,67 @@ sub user_normal_msg_raw { } # Notifications my %userenv = &Apache::loncommon::getemails($user,$domain); - if ($userenv{'notification'}) { - &sendnotification($userenv{'notification'},$user,$domain,$subject,0, - $text,$msgid); + 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,$attachmenturl); } - if ($toperm && $userenv{'permanentemail'}) { - if ((!$userenv{'notification'}) || ($userenv{'notification'} ne $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,$attachmenturl); + } + } + 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; @@ -782,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,$recipid) = @_; + 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; @@ -836,7 +1042,6 @@ sub store_recipients { } } -# =============================================================== Folder suffix sub foldersuffix { my $folder=shift; @@ -851,7 +1056,6 @@ sub foldersuffix { return $suffix; } -# ========================================================= User-defined folders sub get_user_folders { my ($folder) = @_; @@ -872,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)) { @@ -892,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); @@ -958,34 +1137,6 @@ sub decide_receiver { return ($typestyle,%to); } -sub user_lang { - my ($touname,$toudom,$fromcid) = @_; - my @userlangs; - if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) { - @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/, - $env{'course.'.$fromcid.'.languages'})); - } else { - my %langhash = &Apache::loncommon::getlangs($toudom,$touname); - if ($langhash{'languages'} ne '') { - @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'}); - } else { - my %domdefs = &Apache::lonnet::get_domain_defaults($toudom); - if ($domdefs{'lang_def'} ne '') { - @userlangs = ($domdefs{'lang_def'}); - } - } - } - my @languages=&Apache::lonlocal::get_genlanguages(@userlangs); - my $user_lh = Apache::localize->get_handle(@languages); - return $user_lh; -} - -=pod - -=back - -=cut - 1; __END__ 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.