--- loncom/interface/lonmsg.pm	2010/10/28 16:20:50	1.228
+++ loncom/interface/lonmsg.pm	2021/11/30 15:55:37	1.247
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Routines for messaging
 #
-# $Id: lonmsg.pm,v 1.228 2010/10/28 16:20:50 bisitz Exp $
+# $Id: lonmsg.pm,v 1.247 2021/11/30 15:55:37 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -120,7 +120,7 @@ Critical message to a user
 
 New routine that respects "forward" and calls old routine
 
-=item * B<user_crit_msg($user, $domain, $subject, $message, $sendback, $nosentstore,$recipid,$attachmenturl)>: 
+=item * B<user_crit_msg($user, $domain, $subject, $message, $sendback, $nosentstore, $recipid, $attachmenturl, $permresults)>: 
     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.
@@ -148,7 +148,7 @@ New routine that respects "forward" and
 
 =item * B<user_normal_msg($user, $domain, $subject, $message, $citation,
        $baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle,
-       $error,$nosentstore,$recipid)>:
+       $error,$nosentstore,$recipid,$permresults)>:
  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
@@ -200,9 +200,9 @@ Returns
 
 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);
@@ -231,6 +231,7 @@ sub packagemsg {
     $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
     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'},
@@ -250,7 +251,7 @@ sub packagemsg {
     }
     $result .= '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
            '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
-	   '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
+	   '<client>'.$ip.'</client>'.
 	   '<browsertype>'.$env{'browser.type'}.'</browsertype>'.
 	   '<browseros>'.$env{'browser.os'}.'</browseros>'.
 	   '<browserversion>'.$env{'browser.version'}.'</browserversion>'.
@@ -397,14 +398,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)) {
@@ -421,9 +425,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);
@@ -456,37 +461,42 @@ sub sendemail {
     "*** ".($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 '<p><span class="LC_error">' 
+            .&mt('Email not sent.  Attachment exceeds permitted length.')
+            .'</span><br /></p>';
+    } 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/\&lt\;/\</gs;
     $text=~s/\&gt\;/\>/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).
+#FIXME
+    my $url = $protocol.'://'.$hostname.
               '/adm/email?username='.$touname.'&domain='.$toudom.
               '&display='.&escape($msgid);
     my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid,
@@ -525,18 +535,25 @@ 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 '') {
@@ -554,7 +571,9 @@ to access the full message.',$url);
                 }
                 $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) {
@@ -563,8 +582,11 @@ to access the full message.',$url);
             my $htmlfree = &make_htmlfree($text);
             $body = $bodybegin.$bodysubj.$htmlfree.$bodyend;
         }
-        &sendemail($to,$subject,$body,$touname,$toudom,$user_lh);
+        if (&sendemail($to,$subject,$body,$touname,$toudom,$user_lh,$attachmenturl)) {
+            $numsent ++;
+        }
     }
+    return $numsent;
 }
 
 sub make_htmlfree {
@@ -577,7 +599,7 @@ sub make_htmlfree {
 
 sub mynewmail{
 	&newmail();
-	return $env{'user.mailcheck.lastnewmassagetime'} > $env{'user.mailcheck.lastvisit'};
+	return $env{'user.mailcheck.lastnewmessagetime'} > $env{'user.mailcheck.lastvisit'};
 }
 
 
@@ -585,7 +607,7 @@ 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.lastnewmassagetime'=> $what{'recnewemail'}});
+		&Apache::lonnet::appenv({'user.mailcheck.lastnewmessagetime'=> $what{'recnewemail'}});
         if ($what{'recnewemail'}>0) { return 1; }
     }
     return 0;
@@ -621,9 +643,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.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'.
 		$content{'time'}.'</b>: '.$content{'message'}.
 		'<br /></p>';
@@ -641,9 +663,9 @@ sub del_url_author_res_msg {
     $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);
@@ -655,9 +677,9 @@ sub clear_author_res_msg {
     $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);
@@ -668,8 +690,8 @@ sub clear_author_res_msg {
 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;
@@ -692,7 +714,7 @@ sub store_instructor_comment {
 
 sub user_crit_msg_raw {
     my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,
-        $nosentstore,$recipid,$attachmenturl)=@_;
+        $nosentstore,$recipid,$attachmenturl,$permresults)=@_;
 # Check if allowed missing
     my ($status,$packed_message);
     my $msgid='undefined';
@@ -723,22 +745,40 @@ 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;
 }
 
@@ -746,7 +786,7 @@ sub user_crit_msg_raw {
 
 sub user_crit_msg {
     my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,
-        $nosentstore,$recipid,$attachmenturl)=@_;
+        $nosentstore,$recipid,$attachmenturl,$permresults)=@_;
     my @status;
     my %userenv = &Apache::lonnet::get('environment',['msgforward'],
                                        $domain,$user);
@@ -757,13 +797,13 @@ sub user_crit_msg {
          push(@status,
 	      &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message,
 				 $sendback,$toperm,$sentmessage,$nosentstore,
-                                 $recipid,$attachmenturl));
+                                 $recipid,$attachmenturl,$permresults));
        }
     } else { 
 	push(@status,
 	     &user_crit_msg_raw($user,$domain,$subject,$message,$sendback,
 				$toperm,$sentmessage,$nosentstore,$recipid,
-                                $attachmenturl));
+                                $attachmenturl,$permresults));
     }
     if (wantarray) {
 	return @status;
@@ -812,7 +852,7 @@ sub user_crit_received {
 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)=@_;
 # Check if allowed missing
     my ($status,$packed_message);
     my $msgid='undefined';
@@ -849,19 +889,37 @@ 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';
    }
@@ -870,25 +928,26 @@ sub user_normal_msg_raw {
 
 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)=@_;
     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));
         }
     } 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));
     }
     if (wantarray) {
         return @status;
@@ -897,7 +956,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;
@@ -985,6 +1046,9 @@ sub secapply {
     my $rec=shift;
     my $defaultflag=shift;
     $rec=~s/\s+//g;
+    unless ($rec =~ /\:/) {
+        $rec=~s/\@/\:/g;
+    }
     my ($adr,$sections_or_groups)=($rec=~/^([^\(]+)\(([^\)]+)\)/);
     if ($sections_or_groups) {
 	foreach my $item (split(/\;/,$sections_or_groups)) {