Return to lonmsg.pm CVS log

Up to [LON-CAPA] / loncom / interface

Bug Fixes and Received Function

# The LearningOnline Network with CAPA
#
# Routines for messaging
#
# (Routines to control the menu
#
# (TeX Conversion Module
#
# 05/29/00,05/30 Gerd Kortemeyer)
#
# 10/05 Gerd Kortemeyer)
#
# 10/19,10/20 Gerd Kortemeyer

package Apache::lonmsg;

use strict;
use Apache::lonnet();
use vars qw($msgcount);
use HTML::TokeParser;

# ===================================================================== Package

sub packagemsg {
    my ($subject,$message)=@_;
    $message=~s/\</\&lt\;/g;
    $message=~s/\>/\&gt\;/g;
    $subject=~s/\</\&lt\;/g;
    $subject=~s/\>/\&gt\;/g;
    my $now=time;
    $msgcount++;
    my $msgid=$now.'_'.$ENV{'user.name'}.'_'.
           $ENV{'user.domain'}.'_'.$msgcount.'_'.$$;
    return $msgid,
           '<sendername>'.$ENV{'user.name'}.'</sendername>'.
           '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'.
           '<subject>'.$subject.'</subject>'.
	   '<time>'.localtime($now).'</time>'.
	   '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
           '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
	   '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
	   '<browsertype>'.$ENV{'browser.type'}.'</browsertype>'.
	   '<browseros>'.$ENV{'browser.os'}.'</browseros>'.
	   '<browserversion>'.$ENV{'browser.version'}.'</browserversion>'.
           '<browsermathml>'.$ENV{'browser.mathml'}.'</browsermathml>'.
	   '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
	   '<courseid>'.$ENV{'request.course.id'}.'</courseid>'.
	   '<role>'.$ENV{'request.role'}.'</role>'.
	   '<resource>'.$ENV{'request.filename'}.'</resource>'.
           '<msgid>'.$msgid.'</msgid>'.
	   '<message>'.$message.'</message>';
}

# ================================================== Unpack message into a hash

sub unpackagemsg {
    my $message=shift;
    my %content=();
    my $parser=HTML::TokeParser->new(\$message);
    my $token;
    while ($token=$parser->get_token) {
       if ($token->[0] eq 'S') {
	   my $entry=$token->[1];
           my $value=$parser->get_text('/'.$entry);
           $content{$entry}=$value;
       }
    }
    return %content;
}

# =============================== Automated message to the author of a resource

sub author_res_msg {
    my ($filename,$message)=@_;
    unless ($message) { return 'empty'; }
    $filename=&Apache::lonnet::declutter($filename);
    my ($domain,$author,@dummy)=split(/\//,$filename);
    my $homeserver=&Apache::lonnet::homeserver($author,$domain);
    if ($homeserver ne 'no_host') {
       my $id=unpack("%32C*",$message);
       my $msgid;
       ($msgid,$message)=&packagemsg($filename,$message);
       return &Apache::lonnet::reply('put:'.$domain.':'.$author.
         ':nohist_res_msgs:'.
          &Apache::lonnet::escape($filename.'_'.$id).'='.
          &Apache::lonnet::escape($message),$homeserver);
    }
    return 'no_host';
}

# ================================================== Critical message to a user

sub user_crit_msg {
    my ($user,$domain,$subject,$message)=@_;
# Check if allowed missing
    my $status='';
    my $msgid='undefined';
    unless (($message)&&($user)&&($domain)) { $status='empty'; };
    my $homeserver=&Apache::lonnet::homeserver($user,$domain);
    if ($homeserver ne 'no_host') {
       my $msgid;
       ($msgid,$message)=&packagemsg($subject,$message);
       $status=&Apache::lonnet::critical(
           'put:'.$domain.':'.$user.':critical:'.
           &Apache::lonnet::escape($msgid).'='.
           &Apache::lonnet::escape($message),$homeserver);
    } else {
       $status='no_host';
    }
    &Apache::lonnet::logthis(
      'Sending critical email '.$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));
    return $status;
}

# =================================================== Critical message received

sub user_crit_received {
    my $message=shift;
    my %contents=&unpackagemsg($message);
    &Apache::lonnet::log('Received critical message '.$contents{'msgid'});
    &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
                     'Receipt: '.$ENV{'user.name'}.' at '.$ENV{'user.domain'},
                     'User '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.
                     ' acknowledged receipt of message "'.
                     $contents{'subject'}.'" dated '.$contents{'time'}.".\n\n"
                     .'Message ID: '.$contents{'msgid'});
    &Apache::lonnet::put('nohist_email',$contents{'msgid'} => $message);
    &Apache::lonnet::del('critical',$contents{'msgid'});
}

# ======================================================== Normal communication

sub user_normal_msg {
    my ($user,$domain,$subject,$message)=@_;
# Check if allowed missing
    my $status='';
    my $msgid='undefined';
    unless (($message)&&($user)&&($domain)) { $status='empty'; };
    my $homeserver=&Apache::lonnet::homeserver($user,$domain);
    if ($homeserver ne 'no_host') {
       my $msgid;
       ($msgid,$message)=&packagemsg($subject,$message);
       $status=&Apache::lonnet::critical(
           'put:'.$domain.':'.$user.':nohist_email:'.
           &Apache::lonnet::escape($msgid).'='.
           &Apache::lonnet::escape($message),$homeserver);
    } else {
       $status='no_host';
    }
    &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
                         $ENV{'user.home'},
      'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
    return $status;
}

# ================================================= Main program, reset counter

sub BEGIN {
    $msgcount=0;
}

1;
__END__

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.