{ *************************************************************************** }
MODULE mod_handle_mail ;
{  Created  31-JAN-1991 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE   }
{ Modified 12-JUL-1991   add mail server job logfile                          }
{ Modified 18-FEB-1993   use new exception handler routines and flush_to_file }
{ *************************************************************************** }
INCLUDE
  mod_common_global_flags,
  mod_handle_console,
  mod_handle_logfile,
  mod_handle_tracing,
  mod_handle_shared_area,
  $MUTEX;                             {from ELN$:RTLOBJECT.OLB                }
{ *************************************************************************** }
EXPORT

  mailer,           {PROCEDURE code for mail server job                       }
  find_mail_locks,  {PROCEDURE connect to and initialize synch areas          }
  send_mail ;       {PROCEDURE synchronize to mailer to send mail message     }

{ *************************************************************************** }
IMPORT 

  get_host_address,                   {from module MOD_COMMON_GLOBAL_FLAGS    }

  find_console_lock,                  {from module MOD_HANDLE_CONSOLE         }

  init_logfile,                       {from module MOD_HANDLE_LOGFILE         }

  trace_info, ON,                     {from module MOD_HANDLE_TRACING         }
  trace_error,                        {from module MOD_HANDLE_TRACING         }
  handle_trc_sys,                     {from module MOD_HANDLE_TRACING         }
  handle_trc_sta,                     {from module MOD_HANDLE_TRACING         }
  handle_trc_err,                     {from module MOD_HANDLE_TRACING         }
  handle_trc_inf,                     {from module MOD_HANDLE_TRACING         }
  start_time,                         {from module MOD_HANDLE_TRACING         }
  inline_time_now,                    {from module MOD_HANDLE_TRACING         }
  init_flush_to_logfile,              {from module MOD_HANDLE_TRACING         }
  set_trc_exc_mode,                   {from module MOD_HANDLE_TRACING         }
  handle_exception,                   {from module MOD_HANDLE_TRACING         }

  find_area_lock,                     {from module MOD_HANDLE_SHARED_AREA     }

  AREA_LOCK_VARIABLE,                 {from module $MUTEX                     }
  ELN$LOCK_AREA,                      {from module $MUTEX                     }
  ELN$UNLOCK_AREA ;                   {from module $MUTEX                     }
{ *************************************************************************** }

  %INCLUDE 'SITE_DEPENDENT.CST/LIST'

TYPE

  line =  STRING(80) ;

  mail_piece =
  RECORD
    lock     : AREA_LOCK_VARIABLE ;
    address  : line ;
    subject  : line ;
  END ;

  mailer_synch =
  RECORD
    lock     : AREA_LOCK_VARIABLE ;
  END ;

VAR

  five_minutes : LARGE_INTEGER ;

  mailer_area_obj  : AREA ;
  mailer_data      :^mailer_synch ;

  mailmsg_area_obj  : AREA ;
  mailmsg_data      :^mail_piece ;

{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE mailer ;

VAR
  
  mailer_port      : PORT ;
  mail_msg_obj     : MESSAGE ;
  remote_task_name : VARYING_STRING(40) ;
  status           : INTEGER ;
  data_pointer     :^line ; 
  time_now         : STRING(17) ;
  server_logfile   : VARYING_STRING(50) ;
  comma_at : INTEGER ;

BEGIN

  find_console_lock ( CALLER := 'MAIL_SERVER' ) ;

  time_now := inline_time_now ;
  server_logfile := logfile_directory + 'MAIL_SERVER_' + SUBSTR(time_now,1,2) 
           + SUBSTR(time_now,4,3) + SUBSTR(time_now,10,2) + '.LOG'  ;
  trace_info.console  := ON ;   trace_info.logfile  := ON ;
  trace_error.console := ON ;   trace_error.logfile := ON ;
  init_logfile ( NAME := server_logfile, STATUS := status ) ;

  init_flush_to_logfile ;

  ESTABLISH ( exchand_mail_server ) ;

  find_mail_locks ( CALLER := 'MAIL_SERVER' , STATUS := status ) ;
  IF ( status <> 1 ) THEN GOTO quit_mail_server ;

  ELN$LOCK_AREA ( mailer_area_obj, mailer_data^.lock ) ; 

  SIGNAL ( mailmsg_area_obj, STATUS := status ) ;
  IF ( status <> 1 ) 
  THEN handle_trc_sta ( TAG := 'MAI/SRV%sig_area%', STATUS := status ) ;

  CREATE_PORT ( mailer_port, STATUS := status ) ;
  IF ( status <> 1 ) 
  THEN BEGIN
    handle_trc_sta ( TAG := 'MAI/SRV%cre_port%', STATUS := status ) ;
    GOTO quit_mail_server ;
  END ;

  remote_task_name := get_host_address 
                    + host_trguser_account 
                    + host_mailer_decnet_object_name ;

wait_for_mail_request:

  ELN$LOCK_AREA ( mailer_area_obj, mailer_data^.lock ) ; 

retry_after_wait:

  CONNECT_CIRCUIT (mailer_port, 
                   DESTINATION_NAME := remote_task_name,
                   STATUS := status ) ;
  IF ( status <> 1 ) 
  THEN BEGIN
    handle_trc_sta ( TAG := 'MAI/SRV%con_circ%', STATUS := status ) ;
    GOTO wait_and_retry ;
  END ;

  {-------------------------------------------------
   wait for the host to start executing the file remote_task_name.com
          $  OPEN/READ/WRITE network_link SYS$NET
          $  WRITE network_link ""
  -------------------------------------------------}

  WAIT_ANY (mailer_port, STATUS := status ) ;
  IF ( status <> 1 ) 
  THEN BEGIN
    handle_trc_sta ( TAG := 'MAI/SRV%wai_prt1%', STATUS := status ) ;
    GOTO wait_and_retry ;
  END ;

  RECEIVE ( mail_msg_obj, data_pointer, mailer_port, STATUS := status ) ;
  IF ( status <> 1 ) 
  THEN BEGIN
    handle_trc_sta ( TAG := 'MAI/SRV%rcv_msg1%', STATUS := status ) ;
    GOTO wait_and_retry ;
  END 
  ELSE DELETE ( mail_msg_obj ) ;

  {-------------------------------------------------
  the host executes 
          $  READ network_link address
  -------------------------------------------------}

  CREATE_MESSAGE ( mail_msg_obj, data_pointer, STATUS := status ) ;
  IF ( status <> 1 ) 
  THEN BEGIN
    handle_trc_sta ( TAG := 'MAI/SRV%cre_msg1%', STATUS := status ) ;
    GOTO wait_and_retry ;
  END ;

  data_pointer^ := mailmsg_data^.address ;

  SEND ( mail_msg_obj, mailer_port, STATUS := status ) ;
  IF ( status <> 1 ) 
  THEN BEGIN
    handle_trc_sta ( TAG := 'MAI/SRV%snd_msg1%', STATUS := status ) ;
    GOTO wait_and_retry ;
  END ;

  {-------------------------------------------------
  the host executes 
          $  READ network_link subject 
  -------------------------------------------------}

  CREATE_MESSAGE ( mail_msg_obj, data_pointer, STATUS := status ) ;
  IF ( status <> 1 ) 
  THEN BEGIN
    handle_trc_sta ( TAG := 'MAI/SRV%cre_msg2%', STATUS := status ) ;
    GOTO wait_and_retry ;
  END ;

  data_pointer^ := mailmsg_data^.subject ;

  SEND ( mail_msg_obj, mailer_port, STATUS := status ) ;
  IF ( status <> 1 ) 
  THEN BEGIN
    handle_trc_sta ( TAG := 'MAI/SRV%snd_msg2%', STATUS := status ) ;
    GOTO wait_and_retry ;
  END ;

  {-------------------------------------------------
   wait for the host to execute 
          $  MAIL NL0: 'address' /sub="''subject'"
          $  WRITE network_link ""
  -------------------------------------------------}
  WAIT_ANY (mailer_port, STATUS := status ) ;
  IF ( status <> 1 ) 
  THEN BEGIN
    handle_trc_sta ( TAG := 'MAI/SRV%wai_prt2%', STATUS := status ) ;
    GOTO wait_and_retry ;
  END ;

  RECEIVE ( mail_msg_obj, data_pointer, mailer_port, STATUS := status ) ;
  IF ( status <> 1 ) 
  THEN BEGIN
    handle_trc_sta ( TAG := 'MAI/SRV%rcv_msg2%', STATUS := status ) ;
    GOTO wait_and_retry ;
  END 
  ELSE DELETE ( mail_msg_obj ) ;

  comma_at := FIND_MEMBER ( mailmsg_data^.address, [','] ) ;
  IF ( comma_at = 0 ) 
  THEN comma_at := LENGTH(trim_string(mailmsg_data^.address))
  ELSE comma_at := comma_at - 1 ;
  handle_trc_inf ( TAG := 'MAI/SRV%', 
               MESSAGE := ' Mailed to ' 
                        + SUBSTR(mailmsg_data^.address,1,comma_at) 
                        + ': ' + trim_string(mailmsg_data^.subject) ) ;    

  {-------------------------------------------------
  the host executes
          $  CLOSE network_link
  -------------------------------------------------}
  DISCONNECT_CIRCUIT (mailer_port, STATUS := status ) ;
  IF ( status <> 1 ) 
  THEN handle_trc_sta ( TAG := 'MAI/SRV%dsc_port%', STATUS := status ) ;

  {-------------------------------------------------
   go ahead and release the shared area
  -------------------------------------------------}
  SIGNAL ( mailmsg_area_obj, STATUS := status ) ;
  IF ( status <> 1 ) 
  THEN BEGIN
    handle_trc_sta ( TAG := 'MAI/SRV%sig_area%', STATUS := status ) ;
    GOTO wait_and_retry ;
  END ;

GOTO wait_for_mail_request ; 

wait_and_retry:
  handle_trc_err ( TAG := 'MAI/SRV%', 
               MESSAGE := ' Wait 5mn before retry Mailing ' ) ;
  DISCONNECT_CIRCUIT (mailer_port, STATUS := status ) ;
  five_minutes := TIME_VALUE ( '0000 00:05:00.00' ) ;
  WAIT_ANY ( TIME := five_minutes ) ; {five minutes will let netserver   }
  GOTO retry_after_wait ;             {close the link for inactivity,    }
                                      {and insure proper synchronization }
quit_mail_server:
{unlock areas to allow mailer job to be restarted                             }
  ELN$UNLOCK_AREA ( mailer_area_obj, mailer_data^.lock ) ; 
  SIGNAL ( mailmsg_area_obj, STATUS := status ) ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
FUNCTION exchand_mail_server OF TYPE EXCEPTION_HANDLER ;

BEGIN

  set_trc_exc_mode ( TRUE ) ;

  exchand_mail_server := handle_exception ( TAG := 'MAI/EXC%', 
                                       EXC_CODE := signal_args.name ) ;

  handle_trc_sys ( TAG := 'MAI/EXC%', MESSAGE := 'Override: Debugging');
  exchand_mail_server := FALSE ;
  
  set_trc_exc_mode ( FALSE ) ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE find_mail_locks ( caller : VARYING_STRING(16) := '' ;
                        VAR status : INTEGER ) ; 

BEGIN

  find_area_lock ( CALLER := caller,
                AREA_NAME := mailer_area_name,
              AREA_OBJECT := mailer_area_obj,
             AREA_POINTER := mailer_data,
                AREA_SIZE := SIZE(mailer_data^),
                   STATUS := status ) ;
  IF ( status <> 1 ) THEN GOTO quit_find_mail_locks ;

  find_area_lock ( CALLER := caller,
                AREA_NAME := mailmsg_area_name,
              AREA_OBJECT := mailmsg_area_obj,
             AREA_POINTER := mailmsg_data,
                AREA_SIZE := SIZE(mailmsg_data^),
                   STATUS := status ) ;
  IF ( status <> 1 ) THEN GOTO quit_find_mail_locks ;

quit_find_mail_locks:
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE send_mail ( address : VARYING_STRING(80) := '' ;
                    sender_id : VARYING_STRING(24) := '' ;
                      subject : VARYING_STRING(80) ) ;
VAR 
  status : INTEGER ;
  result : INTEGER ;
  comma_at : INTEGER ;

BEGIN

  IF ( mailer_ok = FALSE ) THEN GOTO quit_send_message ;

  IF ( sender_id = '' ) 
  THEN sender_id := 'TRICS V' + trim_string(version_number) 
                  + '/' + SUBSTR(start_time,1,11) + '/' ;

  IF ( address = '' ) THEN address := mail_address ;

  comma_at := FIND_MEMBER ( address, [','] ) ;
  IF ( comma_at = 0 ) 
  THEN comma_at := LENGTH(address) 
  ELSE comma_at := comma_at - 1 ;
  handle_trc_sys ( TAG := 'SND/MAI%', 
               MESSAGE := ' Mailing to ' 
                        + SUBSTR( address, 1, comma_at ) +': '
                        + subject ) ;    

  {use wait instead of lock to specify timeout}
  WAIT_ANY ( mailmsg_area_obj, TIME := - 50000000, 
             STATUS := status, RESULT := result ) ;

  IF ( status <> 1 ) 
  THEN BEGIN
    handle_trc_sta ( TAG := 'WAI/MAI%', STATUS := status ) ;
    GOTO quit_send_message ;
  END
  ELSE IF ( result = 0 ) 
  THEN BEGIN
    handle_trc_err ( TAG := 'WAI/MAI%', 
                 MESSAGE := ' Wait for Mail Server timeout ' ) ;
    GOTO quit_send_message ;
  END ;

  mailmsg_data^.address := address ;
  mailmsg_data^.subject := sender_id + ' ' + subject ;

  ELN$UNLOCK_AREA ( mailer_area_obj, mailer_data^.lock ) ; 

quit_send_message :
END ;
{ *************************************************************************** }
{ *************************************************************************** }
FUNCTION trim_string ( input_string : STRING(<apparent_length>) ) 
  : VARYING_STRING (80) ;
VAR charnum  : INTEGER ;
BEGIN
    
  FOR charnum := apparent_length DOWNTO 1 
  DO IF ( SUBSTR ( input_string, charnum, 1 ) <> ' ' ) THEN GOTO end_found ;

 end_found:
  IF ( charnum = 0 ) 
  THEN trim_string := '' 
  ELSE trim_string := SUBSTR ( input_string, 1, charnum ) ;
 
END ;
{ *************************************************************************** }
{ *************************************************************************** }
END.