File:  [LON-CAPA] / loncom / interface / lonmsg.pm
Revision 1.5: download - view: text, annotated - select for diffs
Tue Oct 31 22:31:37 2000 UTC (23 years, 8 months ago) by www
Branches: MAIN
CVS tags: HEAD
Logs critical messages

    1: # The LearningOnline Network with CAPA
    2: #
    3: # Routines for messaging
    4: #
    5: # (Routines to control the menu
    6: #
    7: # (TeX Conversion Module
    8: #
    9: # 05/29/00,05/30 Gerd Kortemeyer)
   10: #
   11: # 10/05 Gerd Kortemeyer)
   12: #
   13: # 10/19,10/20,10/30 Gerd Kortemeyer
   14: 
   15: package Apache::lonmsg;
   16: 
   17: use strict;
   18: use Apache::lonnet();
   19: use vars qw($msgcount);
   20: use HTML::TokeParser;
   21: use Apache::Constants qw(:common);
   22: 
   23: # ===================================================================== Package
   24: 
   25: sub packagemsg {
   26:     my ($subject,$message)=@_;
   27:     $message=~s/\</\&lt\;/g;
   28:     $message=~s/\>/\&gt\;/g;
   29:     $subject=~s/\</\&lt\;/g;
   30:     $subject=~s/\>/\&gt\;/g;
   31:     my $now=time;
   32:     $msgcount++;
   33:     my $msgid=$now.'_'.$ENV{'user.name'}.'_'.
   34:            $ENV{'user.domain'}.'_'.$msgcount.'_'.$$;
   35:     return $msgid,
   36:            '<sendername>'.$ENV{'user.name'}.'</sendername>'.
   37:            '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'.
   38:            '<subject>'.$subject.'</subject>'.
   39: 	   '<time>'.localtime($now).'</time>'.
   40: 	   '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
   41:            '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
   42: 	   '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
   43: 	   '<browsertype>'.$ENV{'browser.type'}.'</browsertype>'.
   44: 	   '<browseros>'.$ENV{'browser.os'}.'</browseros>'.
   45: 	   '<browserversion>'.$ENV{'browser.version'}.'</browserversion>'.
   46:            '<browsermathml>'.$ENV{'browser.mathml'}.'</browsermathml>'.
   47: 	   '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
   48: 	   '<courseid>'.$ENV{'request.course.id'}.'</courseid>'.
   49: 	   '<role>'.$ENV{'request.role'}.'</role>'.
   50: 	   '<resource>'.$ENV{'request.filename'}.'</resource>'.
   51:            '<msgid>'.$msgid.'</msgid>'.
   52: 	   '<message>'.$message.'</message>';
   53: }
   54: 
   55: # ================================================== Unpack message into a hash
   56: 
   57: sub unpackagemsg {
   58:     my $message=shift;
   59:     my %content=();
   60:     my $parser=HTML::TokeParser->new(\$message);
   61:     my $token;
   62:     while ($token=$parser->get_token) {
   63:        if ($token->[0] eq 'S') {
   64: 	   my $entry=$token->[1];
   65:            my $value=$parser->get_text('/'.$entry);
   66:            $content{$entry}=$value;
   67:        }
   68:     }
   69:     return %content;
   70: }
   71: 
   72: # =============================== Automated message to the author of a resource
   73: 
   74: sub author_res_msg {
   75:     my ($filename,$message)=@_;
   76:     unless ($message) { return 'empty'; }
   77:     $filename=&Apache::lonnet::declutter($filename);
   78:     my ($domain,$author,@dummy)=split(/\//,$filename);
   79:     my $homeserver=&Apache::lonnet::homeserver($author,$domain);
   80:     if ($homeserver ne 'no_host') {
   81:        my $id=unpack("%32C*",$message);
   82:        my $msgid;
   83:        ($msgid,$message)=&packagemsg($filename,$message);
   84:        return &Apache::lonnet::reply('put:'.$domain.':'.$author.
   85:          ':nohist_res_msgs:'.
   86:           &Apache::lonnet::escape($filename.'_'.$id).'='.
   87:           &Apache::lonnet::escape($message),$homeserver);
   88:     }
   89:     return 'no_host';
   90: }
   91: 
   92: # ================================================== Critical message to a user
   93: 
   94: sub user_crit_msg {
   95:     my ($user,$domain,$subject,$message)=@_;
   96: # Check if allowed missing
   97:     my $status='';
   98:     my $msgid='undefined';
   99:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
  100:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
  101:     if ($homeserver ne 'no_host') {
  102:        my $msgid;
  103:        ($msgid,$message)=&packagemsg($subject,$message);
  104:        $status=&Apache::lonnet::critical(
  105:            'put:'.$domain.':'.$user.':critical:'.
  106:            &Apache::lonnet::escape($msgid).'='.
  107:            &Apache::lonnet::escape($message),$homeserver);
  108:     } else {
  109:        $status='no_host';
  110:     }
  111:     &Apache::lonnet::logthis(
  112:       'Sending critical email '.$msgid.
  113:       ', log status: '.
  114:       &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
  115:                          $ENV{'user.home'},
  116:       'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
  117:       .$status));
  118:     return $status;
  119: }
  120: 
  121: # =================================================== Critical message received
  122: 
  123: sub user_crit_received {
  124:     my $message=shift;
  125:     my %contents=&unpackagemsg($message);
  126:     my $status='rec: '.
  127:      &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
  128:                      'Receipt: '.$ENV{'user.name'}.' at '.$ENV{'user.domain'},
  129:                      'User '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.
  130:                      ' acknowledged receipt of message "'.
  131:                      $contents{'subject'}.'" dated '.$contents{'time'}.".\n\n"
  132:                      .'Message ID: '.$contents{'msgid'});
  133:     $status.=' trans: '.
  134:      &Apache::lonnet::put('nohist_email',$contents{'msgid'} => $message);
  135:     $status.=' del: '.
  136:      &Apache::lonnet::del('critical',$contents{'msgid'});
  137:     &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
  138:                          $ENV{'user.home'},'Received critical message '.
  139:                          $contents{'msgid'}.
  140:                          ', '.$status);
  141: }
  142: 
  143: # ======================================================== Normal communication
  144: 
  145: sub user_normal_msg {
  146:     my ($user,$domain,$subject,$message)=@_;
  147: # Check if allowed missing
  148:     my $status='';
  149:     my $msgid='undefined';
  150:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
  151:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
  152:     if ($homeserver ne 'no_host') {
  153:        my $msgid;
  154:        ($msgid,$message)=&packagemsg($subject,$message);
  155:        $status=&Apache::lonnet::critical(
  156:            'put:'.$domain.':'.$user.':nohist_email:'.
  157:            &Apache::lonnet::escape($msgid).'='.
  158:            &Apache::lonnet::escape($message),$homeserver);
  159:     } else {
  160:        $status='no_host';
  161:     }
  162:     &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
  163:                          $ENV{'user.home'},
  164:       'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
  165:     return $status;
  166: }
  167: 
  168: # ===================================================================== Handler
  169: 
  170: sub handler {
  171:     my $r=shift;
  172: 
  173: # ----------------------------------------------------------- Set document type
  174: 
  175:   $r->content_type('text/html');
  176:   $r->send_http_header;
  177: 
  178:   return OK if $r->header_only;
  179: 
  180: # --------------------------------------------------------------- Render Output
  181:   
  182:   $r->print('<html><head><title>EMail and Messaging</title></head>');
  183:   $r->print('<body bgcolor="#FFFFFF">');
  184:   $r->print('<h1>EMail</h1>');
  185:   $r->print('</body></html>');
  186:   return OK;
  187: 
  188: }
  189: # ================================================= Main program, reset counter
  190: 
  191: sub BEGIN {
  192:     $msgcount=0;
  193: }
  194: 
  195: 1;
  196: __END__
  197: 
  198: 
  199: 
  200: 
  201: 
  202: 
  203: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>