From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CUNYVM.CUNY.EDU::MAILSERV-REPLY%UNCG.BITNET" 14-MAR-1989 01:05
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Re: SEND [MAILSERV_SOURCE]V101.*  ([MAILSERV_SOURCE]V101.2_OF_4)


Received: from uncg.bitnet by CUNYVM.CUNY.EDU (IBM VM SMTP R1.1) with BSMTP id 7208; Tue, 14 Mar 89 00:40:39 EST
Date: Mon, 13 Mar 89 16:28 EST
From: "PMDF Mailserv V1.02" <MAILSERV-REPLY%UNCG.BITNET@CUNYVM.CUNY.EDU>
Subject: Re: SEND [MAILSERV_SOURCE]V101.*  ([MAILSERV_SOURCE]V101.2_OF_4)
To: EVERHART%ARISIA.decnet@GE-CRD.ARPA

+-+-+-+ Beginning of part 2 +-+-+-+
X(*                                                                 *)
X(*    The following subroutine packages are used by the MAILSERV   *)
X(*    program:                                                     *)
X(*                                                                 *)
X(*      (1) util - utility functions                               *)
X(*      (2) os   - operating system dependent functions            *)
X(*      (3) qu   - message file reading                            *)
X(*      (4) ap   - address parsing                                 *)
X(*      (5) mm   - message submission                              *)
X(*      (6) log  - log file support                                *)
X(*                                                                 *)
X(*    Input files -                                                *)
X(*                                                                 *)
X(*      outbound    - A list of filenames of message files to      *)
X(*                    be processed.                                *)
X(*                                                                 *)
X(*  Modifications:    `009`009`009`009`009`009   *)
X(*`009`009`009`009`009`009`009`009   *)
X(*  25-JAN-1989  Eric Thies  - finished initial coding of V1.01    *)
X(*                                                                 *)
X(*******************************************************************)
X
XCONST`032
X
X  %INCLUDE 'UTILCONST.INC'
X  %INCLUDE 'OSCONST.INC'
X  %INCLUDE 'APCONST.INC'
X  %INCLUDE 'MMCONST.INC'
X  %INCLUDE 'HECONST.INC'
X  %INCLUDE 'LOGCONST.INC'
X
X  DEBUG = FALSE;
X
X  MAILSERV_VERSION = 'PMDF Mailserv V1.01';
X  MAILSERV_FILES_DIR = 'MAILSERV_FILES_DIR:';
X  MAILSERV_MAIL_DIR = 'MAILSERV_MAIL_DIR';
X  MAILSERV_COMMAND_LIMIT = 'MAILSERV_COMMAND_LIMIT';
X  MAILSERV_LOGFILE = 'PMDF_ROOT:[LOG]MAILSERV.LOG;0';
X
X  MAX_TEXT_LINE_LEN = 255;
X
XTYPE`032
X
X  %INCLUDE 'UTILTYPE.INC'
X  %INCLUDE 'OSTYPE.INC'
X  %INCLUDE 'APTYPE.INC'
X  %INCLUDE 'MMTYPE.INC'
X  %INCLUDE 'HETYPE.INC'
X  %INCLUDE 'LOGTYPE.INC'
X
X  $UBYTE = [byte] 0..255;`009(*  unsigned byte  *)
X  $UWORD = [word] 0..65535;
X
V  sig_args = array [0..100] of integer;`009(*  signal arguments for handler
X  *)
V  mech_args = array [0..4] of integer;`009(*  mech.  arguments for handler  *
X)
X
X  (*  a normal vms string descriptor  *)
X  longest_string = packed array [1..65535] of char;
X  string_desc = record     `009(*  hacked this from pmdf_mail.pas  *)
X    length : [word] 0..65535;
X    dtype, dclass : [byte] 0..255;
X    address : `094longest_string;
X  end;
X
X  (*  a pointer and record for a line of text *)
X  text_line_ptr = `094text_line_rec;
X  text_line_rec = record
X    line : varying [max_text_line_len] of char;
X    next : `094text_line_rec;
X  end;
X
X  var80 = varying [80] of char;  (*  good old varying array  *)
X  varalfa = varying [ALFA_SIZE] of char;
XVAR`032
X
X  %INCLUDE 'UTILVAR.INC'
X  %INCLUDE 'OSVAR.INC'
X  %INCLUDE 'QUVAR.INC'
X  %INCLUDE 'APVAR.INC'
X  %INCLUDE 'MMVAR.INC'
X  %INCLUDE 'HEVAR.INC'
X  %INCLUDE 'LOGVAR.INC'
X
X  outbound : TEXT;
X  filename, line, inter_line, to_address, return_address : vstring;
X  header_stuff : he_header;
X  longline, current_command, from_to_use : bigvstring;
X  rp : rp_replyval;
X  result : rp_bufstruct;
X  error_in_command : BOOLEAN;
X  command_limit : INTEGER;
X  commands_processed : INTEGER;
X  i : INTEGER;
X
X  mailserv_tables : [EXTERNAL] UNSIGNED;  (*  the .cld tables  *)
X  ret_status : UNSIGNED;
X  send_p1, send_p2 : PACKED ARRAY [1..255] OF CHAR := ' ';
X  send_p1_len, send_p2_len : UNSIGNED := 0;
X  error_line_head, error_line_tail : [VOLATILE] text_line_ptr;
X  curr_error_line : text_line_ptr;
X
X  myfab : [volatile] fab$type;
X  mynam : [volatile] nam$type;
X
X(*********************************************************************)
X(*`009`009`009`009`009`009`009             *)
X(*  external routine declarations                                    *)
X(*`009`009`009`009`009`009`009`009     *)
X(*********************************************************************)
X
X  %INCLUDE 'UTILDEF.INC'
X  %INCLUDE 'OSDEF.INC'
X  %INCLUDE 'APDEF.INC'
X  %INCLUDE 'HEDEF.INC'
X  %INCLUDE 'LOGDEF.INC'
X  %INCLUDE 'MMDEF.INC'
X  %INCLUDE 'QUDEF.INC'
X
X(*  had to change this, the one in starlet did't work  *)
X[ASYNCHRONOUS,EXTERNAL] FUNCTION SYS$PUTMSG (
X  %REF MSGVEC : [UNSAFE] ARRAY [$l1..$u1:INTEGER] OF $UBYTE;
X  %IMMED [UNBOUND, ASYNCHRONOUS] FUNCTION ACTRTN (
X    VAR inline : string_desc) : UNSIGNED := %IMMED 0;
X  FACNAM : [CLASS_S] PACKED ARRAY [$l3..$u3:INTEGER] OF CHAR := %IMMED 0;
X  %IMMED ACTPRM : UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
X
XFUNCTION CLI$DCL_PARSE (
X  command : PACKED ARRAY [l1..u1 : INTEGER] OF CHAR;
X  table   : UNSIGNED;
X  %IMMED [UNBOUND] PROCEDURE parameter_routine := %IMMED 0;
X  %IMMED [UNBOUND] PROCEDURE prompt_routine := %IMMED 0;
X  prompt  : PACKED ARRAY [l2..u2 : INTEGER] OF CHAR := %IMMED 0 )
X  : UNSIGNED; EXTERN;
X
XFUNCTION CLI$GET_VALUE (
X  entity : PACKED ARRAY [l1..u1 : INTEGER] OF CHAR;
X  VAR retval : PACKED ARRAY [l2..u2 : INTEGER] OF CHAR;
X  VAR retlen : UNSIGNED ): UNSIGNED; EXTERN;
X
XFUNCTION CLI$PRESENT (
X  entity : PACKED ARRAY [l1..u1 : INTEGER] OF CHAR): UNSIGNED; EXTERN;
X
XFUNCTION CLI$DISPATCH (
X  userarg : UNSIGNED := %IMMED 0): UNSIGNED; EXTERN;
X
XFUNCTION STR$TRIM (
X  VAR dest_string : PACKED ARRAY [l1..u1 : INTEGER] OF CHAR;
X  src_string : PACKED ARRAY [l2..u2 : INTEGER] OF CHAR;
X  retlen : UNSIGNED ): UNSIGNED; EXTERN;
X
XFUNCTION STR$UPCASE (
X  VAR dest_string : [CLASS_S] PACKED ARRAY [l1..u1 : INTEGER] OF CHAR;
X  src_string : [CLASS_S] PACKED ARRAY [l2..u2 : INTEGER] OF CHAR):`032
X  UNSIGNED; EXTERN;
X
X[EXTERNAL] FUNCTION ots$cvt_tu_l (
X  cv_string : [CLASS_S] PACKED ARRAY [l1..u1 : INTEGER] OF CHAR;
X  target : INTEGER;
X  size_of : UNSIGNED := %IMMED 0;
X  the_flags : UNSIGNED := %IMMED 0): UNSIGNED; EXTERN;
X
X[EXTERNAL] FUNCTION lib$find_file (
X  file_spec : [CLASS_S] PACKED ARRAY [l1..u1 : INTEGER] OF CHAR;
X  VAR res_spec : [CLASS_S] PACKED ARRAY [l2..u2 : INTEGER] OF CHAR;
X  VAR context : UNSIGNED;
X  def_spec : PACKED ARRAY [l3..u3 : INTEGER] OF CHAR := %IMMED 0;
X  rel_spec : PACKED ARRAY [l4..u4 : INTEGER] OF CHAR := %IMMED 0;
X  stv_addr : UNSIGNED := %IMMED 0;
X  user_flags : UNSIGNED := %IMMED 0): UNSIGNED; EXTERN;
X
X[ASYNCHRONOUS] FUNCTION SYS$SETDDIR (
Xcur_def : [class_s] packed array [l1..u1 : integer] of char := %IMMED 0;
XVAR ret_len : $UWORD :=%IMMED 0;
XVAR ret_def : [class_s] packed array [l2..u2 : integer] of char := %IMMED 0):
X  unsigned; extern;
X
X(***************************************************************************)
X(*                                                                         *)
X(*  ABORT_IT - abort this sucker                                           *)
X(*                                                                         *)
X(***************************************************************************)
XPROCEDURE abort_it (error_text : varalfa);
XBEGIN
X  WRITELN (OUTPUT);
X  os_write_datetime (output);
X  WRITELN (OUTPUT, error_text);
X  HALT;
XEND;  (*  abort_it  *)
X
V(****************************************************************************
X)
V(*                                                                          *
X)
V(*  PROCESS_ERROR_LINE - called by $PUTMSG with each line of error text     *
X)
V(*  to process.  This routine makes a linked list of error text passed to   *
X)
V(*  it for later use in notification of errors.                             *
X)
V(*                                                                          *
X)
V(****************************************************************************
X)
X[ASYNCHRONOUS] FUNCTION process_error_line`032
X  (VAR error_line : string_desc): UNSIGNED;
X
XVAR                           `032
X  i : INTEGER;
X  new_error_line : text_line_ptr;
X
XBEGIN
X  (*  allocate a new error line record and fill it in  *)
X  NEW (new_error_line);
X  new_error_line`094.line.length := error_line.length;
X  FOR i := 1 to error_line.length DO
X    new_error_line`094.line.body[i] := error_line.address`094[i];
X
X  (*  link this record into the list of error lines  *)
X  IF (error_line_head = nil) THEN BEGIN
X    error_line_head := new_error_line;
X    error_line_tail := new_error_line;
X  END
X  ELSE BEGIN
X    error_line_tail`094.next := new_error_line;
X    error_line_tail := new_error_line;
X  END;
X
X  (*  return 0 so that $PUTMSG won't write the message  *)
X  process_error_line := 0;
X
XEND;  (*  process_error_line  *)
X
X(***************************************************************************)
X(*                                                                         *)
X(*  MY_HANDLER - an exception handler for trapping error messages generated*)
X(*  by CLI$DCL_PARSE.  We'll use dcl_parse to parse the command strings    *)
X(*  and when they don't parse, we trap the error text to return to the     *)
X(*  message originator.                                                    *)
X(*                                                                         *)
X(***************************************************************************)
X[ASYNCHRONOUS] FUNCTION my_handler (
X   VAR SA : sig_args;
X   VAR MA : mech_args) : [UNSAFE] integer;
X
XTYPE
X  condition_value = PACKED RECORD
X    severity : [POS(0), BIT(3)] 0..7;
X    message  : [POS(3), BIT(13)] 0..8191;
X    facility : [POS(16),BIT(12)] 0..4095;
X    control  : [POS(28),BIT(4)] 0..15;
X  END;
X
XBEGIN
X  (*  set default message options in high order word of first longword  *)
X  sa[0] := (sa[0] MOD (2**15-1)) + 2**16-1;  (*  do this better  *)
X
X  (*  if it's a CLI error, trap the error text  *)
X  IF (sa[1]::condition_value.facility = 3) THEN BEGIN
X    SYS$PUTMSG(sa,process_error_line,,);
X    my_handler := SS$_CONTINUE;
X  END
X  (*  otherwise resignal it *)
X  ELSE my_handler := SS$_RESIGNAL
XEND;  (*  my_handler  *)
X
X(***********************************************************************)
X(*                                                                     *)
X(*  DISPOSE_TEXT_LIST - dispose of a linked list of text lines         *)
X(*                                                                     *)
X(***********************************************************************)
XPROCEDURE dispose_text_list (VAR head_ptr : [VOLATILE] text_line_ptr);
X
XVAR
X  curr_ptr, next_ptr : text_line_ptr;
X
XBEGIN
X  IF DEBUG THEN WRITELN ('Entered routine DISPOSE_TEXT_LIST');
X  curr_ptr := head_ptr;
X  next_ptr := head_ptr;
X  WHILE (curr_ptr <> nil) DO BEGIN
X    next_ptr := curr_ptr`094.next;
X    dispose (curr_ptr);
X    curr_ptr := next_ptr;
X  END;
X  head_ptr := nil;
XEND;  (*  dispose_text_list  *)
X
X(***********************************************************************)
X(*                                                                     *)
X(*  PARSE_FILE_SPEC - check for a directory, name and type in the      *)
X(*  input filespec.                                                    *)
X(*                                                                     *)
X(***********************************************************************)
VFUNCTION parse_file_spec (filespec : varalfa; VAR retspec: varalfa) : BOOLEAN
X;
X
XVAR
X  tempspec :[volatile] varalfa;
X  myaddr : `094longest_string;
X  myesa : [volatile] packed array [1..255] of char;
X  def_len : $UWORD;
X  current_default : PACKED ARRAY [1..255] OF CHAR;
X  ret_status : unsigned;
X
XBEGIN
X
X  IF DEBUG THEN WRITELN ('Entered routine PARSE_FILE_SPEC');
X
X  parse_file_spec := FALSE;  (*  assume the spec didn't parse  *)
X
X  tempspec := filespec;  (*  copy over to volatile variable  *)
X
X  (*  init the fab and nam blocks  *)
X  myfab.fab$b_bid := fab$c_bid;
X  myfab.fab$b_bln := fab$c_bln;
X  myfab.fab$w_ifi := 0;    (*  zero ifi for multiple calls  *)
X  mynam.nam$b_bid := nam$c_bid;
X  mynam.nam$b_bln := nam$c_bln;
X
X  myfab.fab$l_nam := (address (mynam))::unsigned;
X  myfab.fab$l_fna := (address (tempspec.body))::unsigned;
X  myfab.fab$b_fns := tempspec.length;
X  mynam::nam$type.nam$v_synchk := true;  (*  only check syntax  *)
X  mynam.nam$l_esa := (address(myesa))::unsigned;
X  mynam.nam$b_ess := 255;
X
X  ret_status := SYS$SETDDIR (,def_len,current_default);
X  IF DEBUG THEN BEGIN
X    WRITELN ('  Obtained current default directory = ',
X      SUBSTR (current_default,1,def_len));
X    WRITELN ('  status of call = ', ret_status);
X  END;
X  IF NOT ODD (ret_status) THEN abort_it ('error calling sys$setddir');
X  IF DEBUG THEN WRITELN ('  Setting current default to [000000]');
X  ret_status := SYS$SETDDIR ('[000000]',,);
X  IF DEBUG THEN WRITELN ('  status = ', ret_status);
X  IF NOT ODD (ret_status) THEN abort_it ('error calling sys$setddir');
X
X  ret_status := $PARSE (fab := myfab);
X  if odd (ret_status) THEN BEGIN
X    WITH mynam DO BEGIN
X
X      IF DEBUG THEN BEGIN
X        WRITELN ('  Input spec is ', filespec);
X        if (nam$v_exp_dev) then writeln ('  Explicit device');
X        if (nam$v_exp_dir) then writeln ('  Explicit dir');
X        if (nam$v_exp_name) then writeln ('  Explicit name');
X        if (nam$v_exp_type) then writeln ('  Explicit type');
X        if (nam$v_exp_ver) then writeln ('  Explicit version');
X
X        if (nam$v_wild_dir) then writeln ('  Wild directory');
X        if (nam$v_wild_name) then writeln ('  Wild name');
X        if (nam$v_wild_type) then writeln ('  Wild type');
X        if (nam$v_wild_ver) then writeln ('  Wild version');
X      END;
X
X      (*  if they at least gave a name and type  *)
X      if ((nam$v_exp_name) and
X         (nam$v_exp_type)) THEN BEGIN
X        parse_file_spec := TRUE;
X        myaddr::unsigned := nam$l_dir;
X        retspec := substr(myaddr`094,1,nam$b_dir+nam$b_name+nam$b_type);
X        IF DEBUG THEN WRITELN ('  Chosen filename = ', retspec);
X      END
X      ELSE BEGIN
X        IF DEBUG THEN WRITELN ('  Name and type not both present');
X      END;
X    END; (*  with  *)
X  END
X  ELSE BEGIN
X    IF DEBUG THEN WRITELN ('  Error in call to $PARSE = ', ret_status);
X  END;
X
X  IF DEBUG THEN WRITELN ('  Restoring current default directory.');
X  ret_status := sys$setddir (substr(current_default,1,def_len),,);
X
X(* `032
X    perhaps should distinguish between failure in parse and failure to
X    specify both name and type...also don't know how to release stuff`032
X    which was allocated by the $PARSE...
X*)
XEND;  (*  parse_file_spec  *)
X
X(***********************************************************************)
X(*                                                                     *)
X(*  WRITE_VARALFA - write a varalfa string to the output message       *)
X(*                                                                     *)
X(***********************************************************************)
XPROCEDURE write_varalfa (instring : varalfa);
XVAR
X  write_string : vstring;
XBEGIN
X  (*  copy over to write_string  *)
X  write_string.length := instring.length;
X  write_string.body := instring.body;
X
X  catchar (write_string, chr (chr_lf));
X  IF rp_isbad (mm_wtxt(write_string)) THEN`032
X    abort_it ('Error writing string in WRITE_VARALFA');
XEND;  (*  write_varalfa  *)
X
X(***********************************************************************)
X(*                                                                     *)
X(*  UPCASE_VAR80 - upcase a var80 string                               *)
X(*                                                                     *)
X(***********************************************************************)
XFUNCTION upcase_var80 (instring : var80): var80;
X
XVAR
X  ret_status : unsigned;
X  temp_80 : var80;
XBEGIN
X  IF DEBUG THEN WRITELN ('Entering routing UPCASE_VAR80');
X  temp_80.length := instring.length;
X  ret_status := STR$UPCASE (temp_80.body, instring.body);
X  IF DEBUG THEN BEGIN
X    WRITELN ('  Upcased: ', instring);
X    WRITELN ('       to: ', temp_80);
X  END;
X  upcase_var80 := temp_80;
XEND;  (*  upcase_var80  *)
X
X(***********************************************************************)
X(*                                                                     *)
X(*  LOG_IT - log the current command                                   *)
X(*                                                                     *)
X(***********************************************************************)
XPROCEDURE log_it;
XVAR
X  time_string : packed array [1..23] of char;
X  logfile : TEXT;
XBEGIN
X  IF DEBUG THEN WRITELN ('Entered routine LOG_IT');
X  OPEN (FILE_VARIABLE := logfile,
X        FILE_NAME := MAILSERV_LOGFILE,
X`009HISTORY := OLD,
X        RECORD_LENGTH := 1024,
X        ERROR := CONTINUE);
X  IF DEBUG THEN WRITELN ('  status of logfile open = ', STATUS(logfile));
X  IF (STATUS (logfile) = 0) THEN BEGIN  (*  if the extend went okay  *)
X    EXTEND (logfile);
X    $ASCTIM (TIMBUF := time_string);
X    WRITE (logfile, SUBSTR(time_string,1,6));
X    WRITE (logfile, SUBSTR(time_string,12,9));
X(*  write error status  *)
X    IF error_in_command THEN`032
X      WRITE (logfile, ' E ')
X    ELSE
X      WRITE (logfile, ' S ');
X(*  write return address and command  *)
X    WRITE (logfile, SUBSTR(return_address.body,1,return_address.length));
V    WRITE (logfile,'  ',SUBSTR(current_command.body,1,current_command.length)
X);
X    WRITELN (logfile);
X  END
X  ELSE BEGIN   (*  didn't write to log file  *)
X    IF DEBUG THEN WRITELN ('  no logging done');
X  END;
XEND;  (*  log_it  *)
X
X(***********************************************************************)
X(*                                                                     *)
X(*  TRIM_COMMAND - trim an input command                               *)
X(*                                                                     *)
X(***********************************************************************)
XPROCEDURE trim_command;
X
XVAR
X  ret_status : UNSIGNED;
X`032
XBEGIN
X  IF DEBUG THEN WRITELN ('Entered routine TRIM_COMMAND');
X  ret_status := STR$TRIM (
V    current_command.body, substr(current_command.body,1,current_command.lengt
Xh),
X    current_command.length);
X  IF NOT ODD (ret_status) THEN BEGIN
X    WRITELN (' str$trim return status was ', ret_status);
X    abort_it (' error in call to str$trim in trim_command');
X  END;
X `032
X  IF DEBUG THEN WRITELN ('  Input command trimmed to length ',`032
X    current_command.length);
X
XEND;  (*  trim_command  *)
X
X(**************************************************************************)
X(*                                                                        *)
X(*  START_REPLY - start the output message, do stuff up to the body of    *)
X(*  the message.                                                          *)
X(*                                                                        *)
X(**************************************************************************)
XPROCEDURE start_reply;
X
XVAR
X  local_chan_len : INTEGER;
XBEGIN
X  (*  build the reply message, sender is mailserv-reply  *)
X  IF DEBUG THEN WRITELN ('Entering routine START_REPLY');
X  initstring (line, 'mailserv-reply@                         ', 15);
X  catvstring (line, mm_local_channel`094.official_hostname);
X  IF rp_isbad (mm_winit ('l           ', line)) THEN
X    abort_it (' error calling mm_winit in start_message');
X
X  (*  write sender's address *)
X  IF rp_isbad (mm_wadr (mm_local_channel`094.official_hostname,`032
X    return_address)) THEN
X      abort_it (' error calling mm_wadr in start_message  ');
X
X  (*  write end of addresses  *)
X  IF rp_isbad (mm_waend) THEN
X    abort_it (' error calling mm_waend in start_message ');
X
X  (*  write header to outgoing message  *)
X  IF DEBUG THEN WRITELN ('  Making reply header.');
X
X  initstring (line, 'Date:                                   ', 6);
X  os_cnvtdate (line);
X  write_varalfa (SUBSTR(line.body,1,line.length));
X
X  local_chan_len := mm_local_channel`094.official_hostname.length;
X  write_varalfa ('From: ' +`032
X    MAILSERV_VERSION +`032
X    ' <MAILSERV-REPLY@' +
X    substr(mm_local_channel`094.official_hostname.body,1,local_chan_len) +
X    '>');
X
X  write_varalfa ('Subject: Re: ' +`032
X    substr(current_command.body,1,current_command.length));
X  write_varalfa ('To: ' + substr(from_to_use.body,1,from_to_use.length));
X  (*  finish the header  *)
X  write_varalfa ('');
X
XEND;  (*  start_reply  *)
X
X(***********************************************************************)
X(*                                                                     *)
X(*  END_REPLY - write the end of the reply message                     *)
X(*                                                                     *)
X(***********************************************************************)
XPROCEDURE end_reply;
X
XBEGIN
X  IF DEBUG THEN WRITELN ('Entering routing END_REPLY');
X
X  (*  if error, then no more commands will be processed  *)
X  IF error_in_command THEN BEGIN
X    IF DEBUG THEN WRITELN`032
X      ('  writing "all further commands will be ignored" msg.');
X    write_varalfa ('');
X    write_varalfa ('All further commands will be ignored.');
X  END;
X
X  (*  close the message  *)
X  IF DEBUG THEN WRITELN ('  Closing the output message');
X  IF rp_isbad (mm_wtend) THEN
X    abort_it ('error closing message');
XEND; (*  end_reply  *)
X
X(***********************************************************************)
X(*                                                                     *)
X(*  COPY_FILE - copy a file to the output message                      *)
X(*                                                                     *)
X(***********************************************************************)
XPROCEDURE copy_file (prefix : varalfa; filename : varalfa);
X
XVAR
X  inline : vstring;
X  text_file : TEXT;
X  full_filename: varalfa;
X
XBEGIN
X  IF DEBUG THEN WRITELN ('Entered routine COPY_FILE');
X
X  full_filename := prefix + filename;
X
X  IF DEBUG THEN WRITELN ('  opening ', full_filename);
X  open (FILE_VARIABLE := text_file,`032
X        FILE_NAME := full_filename,
X        HISTORY := READONLY,
X`009ERROR := CONTINUE);
X
X  IF (STATUS (text_file) = 0) THEN BEGIN
X    IF DEBUG THEN WRITELN ('  copying input file to output message.');
X    RESET (text_file);
X    WHILE NOT EOF (text_file) DO BEGIN
X      readvstring (text_file, inline, 0);
X      write_varalfa (substr(inline.body,1,inline.length));
X    END;  (*  while  *)
X    CLOSE (text_file);
X  END
X  ELSE BEGIN
X    IF DEBUG THEN WRITELN ('  could not open the input file');
X    write_varalfa ('The file ' + filename + ' is not currently available.');
X    write_varalfa`032
V      ('Please check to make sure you have spelled and specified it correctly
X.');
X    error_in_command := TRUE;
X  END;
XEND;  (*  copy_file  *)
X `032
X(***********************************************************************)
X(*                                                                     *)
X(*  SEND_ROUTINE - handles the SEND verb.                              *)
X(*                                                                     *)
X(***********************************************************************)
X[global] FUNCTION send_routine : UNSIGNED;
X                         `032
XCONST
X  CLI$_PRESENT = 261401;`009(*  yucky hardcode, isn't in starlet  *)
XVAR
X  local_filename : varalfa;  (*  local copy  of filename  *)
X  returned_filename : varalfa;  (*  filespec returned from parse_file_spec *)
XBEGIN
X  IF DEBUG THEN WRITELN ('Entered routine SEND_ROUTINE');
X  ret_status := CLI$GET_VALUE('SEND_P1', send_p1, send_p1_len);
X
X  IF ODD(ret_status) THEN BEGIN
X    local_filename := substr(send_p1,1,send_p1_len);
X
X    (*  handle the optional second parameter  *)
X    ret_status := CLI$PRESENT ('SEND_P2');
X    IF (ret_status = CLI$_PRESENT) THEN BEGIN
X      IF DEBUG THEN WRITELN ('  Getting second SEND parameter');
X      ret_status := CLI$GET_VALUE ('SEND_P2', send_p2, send_p2_len);
V      IF NOT ODD (ret_status) THEN abort_it ('error getting second SEND parm'
X)
X      ELSE local_filename := local_filename + '.' +
X        SUBSTR (send_p2,1,send_p2_len);
X    END;
X
X    IF DEBUG THEN WRITELN ('  File specified was ', local_filename);
X
X    IF parse_file_spec (local_filename, returned_filename) THEN BEGIN
X      start_reply;
-+-+-+-+-+ End of part 2 +-+-+-+-+-
