From:	CRDGW2::CRDGW2::MRGATE::"SMTP::UBVMSC.CC.BUFFALO.EDU::SYSTEM" 23-JUN-1989 19:45
To:	MRGATE::"ARISIA::EVERHART"
Subj:	DISK$ACSDISK2:[VMSSERV.VAX]VMSSERV.3_OF_4;1

Message-Id:  <8906231653.AA04866@crdgw1.ge.com>
Date: Fri, 23 Jun 89 12:42 EDT
From: SYSTEM@ubvmsc.cc.buffalo.edu
Subject: DISK$ACSDISK2:[VMSSERV.VAX]VMSSERV.3_OF_4;1
To: everhart@arisia.decnet
X-Vms-To: IN%"everhart%arisia.decnet@crdgw1.ge.com"

+-+-+-+ Beginning of part 3 +-+-+-+
X`009janlogmsg.dsc$a_pointer = s ;
X`009janlogmsg.dsc$b_class   = DSC$K_CLASS_S ;
X`009janlogmsg.dsc$b_dtype   = DSC$K_DTYPE_T ;
X`009jan_jlog( &hook_name,&janlogmsg ) ;
X`009return(1) ;
X`125
X
X
Xsendlogfile_dsc(s)
Xstruct dsc *s;
X`123
X
X`009jan_jlog( &hook_name,s ) ;
X`009return(1) ;
X`125
X
X
Xinit_logfile()
X`123
X        char *msg ;
X
X`009msg = xmalloc(strlen(hook_name.dsc$a_pointer)+18+strlen(version)) ;
V        sprintf(msg,"%s Version %s started",hook_name.dsc$a_pointer,version)
X ;
X        sendlogfile(msg) ;
X        jan_version_dsp(&sendlogfile_dsc) ;
X`125
X
Xlog_request(n,u,r,type)
Xchar *n,*u,*r ;
Xchar type ;
X`123
X`009int requests ;
X`009char *cp ;
X
X`009cp=xmalloc(strlen(u)+strlen(n)+strlen(r)+80) ;
X`009if ( ( type&0137 ) == 'I' )
X`009  sprintf(cp,"%c %-10s%-10s%-50s",type,n,u,r) ;
X`009  else sprintf(cp,"%c %s %s",type,u,r) ;
X`009sendlogfile(cp) ;
X`009xfree(cp) ;
X`009if ( *(cp = tranlog(requests_since_boot_logical)) ) `123
X`009  sscanf(cp,"%d",&requests) ;
X`009  sprintf(cp,"%d",++requests) ;
X`009  create_logical(requests_since_boot_logical,cp) ;
X`009`125 ;
X`009xfree(cp) ;
X`009requests_since_restart++ ;
X`125
X
X`012
X
X
Xchar *getmsg(n)
Xint n ;
X`123
X`009static char sysmsg[257] ;
X`009struct dsc msgd ;
X`009int mlen ;
X`009char junk[4] ;
X
X`009mlen = 0 ;
X`009msgd.len = 256 ;
X`009msgd.addr = sysmsg ;
X`009sys$getmsg(n,&mlen,&msgd,0,&junk) ;
X`009sysmsg[mlen] = 0 ;
X`009return( &sysmsg ) ;
X`125
X
X`009
Xreport_error(s,n)
Xchar *s; int n ;
X`123
X`009char *cp,*dp ;
X
X`009cp = getmsg(n) ;
X`009dp = xmalloc(strlen(hook_name.dsc$a_pointer)+strlen(s)+strlen(cp)+10) ;
X`009sprintf(dp,"W %s %s :%s",hook_name.dsc$a_pointer,s,cp) ;
X`009sendlogfile(dp) ;
X`009xfree(dp) ;
X`125
X
X`012
X
X
X/*
X Sendbatch() submits a batch job to a queue. The queue is,  guess  what,
Xspecified  by  the  logical 'HOOK_NAME'_BATCH_QUEUE at startup, ie for a
Xhook called VMSSERV, it uses VMSSERV_BATCH_QUEUE. Ditto for the username
Xto  submit  the   job   under,   for   a   hook   called   VMSSERV   its
XVMSSERV_BATCH_USERNAME.  Note again, please, that these logicals do have
Xdefaults, which are hardcoded in the image (see comments at the start of
Xthis file), and that these logicals are set up in Generate_logicals().
X\BDN`032
X
XPassed:`009F`009char*, pointer to the filename.type to submit
X`009LATE`009int  , flag to specify deferred submission
X`009PARAMS`009char **, pointers to paramaters. Ie, the caller could
X`009`009declare an array and set up pointers to P1,P2, ...P8.
X`009`009The Nth+1 entry MUST point to a null string.
X
X`009`009char *parameters[3]
X`009`009paramaters[0] = "This is P1"
X`009`009paramaters[1] = "This is P2"
X`009`009paramaters[2] = ""
X
X
XReturn:`009System service status
X
X
X*/
X
Xsendbatch(f,late,params)
Xchar *f,**params ;
Xint late ;
X`123
X
X#define`009SJC$_AFTER_TIME`009`0093
X#define`009SJC$_ENTER_FILE`009`00919
X#define`009SJC$_QUEUE`009`009134
X#define`009SJC$_FILE_SPECIFICATION`00942
X#define SJC$_LOG_SPECIFICATION`00998
X#define`009SJC$_NO_LOG_SPOOL`009101
X#define`009SJC$_NO_DELETE_FILE`00925
X#define`009SJC$_USERNAME`009`009159
X#define`009SJC$_NO_PAGINATE`009118
X#define`009SJC$_PARAMETER_1`009119
X#define`009SJC$_PARAMETER_2`009120
X#define`009SJC$_PARAMETER_3`009121
X#define`009SJC$_PARAMETER_4`009122
X#define`009SJC$_PARAMETER_5`009123
X#define`009SJC$_PARAMETER_6`009124
X#define`009SJC$_PARAMETER_7`009125
X#define`009SJC$_PARAMETER_8`009126
X#define`009SJC$_NO_PARAMETERS`009127
X
X`009struct itmlst`009`123
X`009`009`009short int buflen;
X`009`009`009short int code`009;
X`009`009`009char *bufadr`009;
X`009`009`009int *retlen`009;
X`009`009`009`125 ;
X
X`009$DESCRIPTOR(latetime,"-- 23:00:00.00") ;
X`009static struct itmlst dobatch[20] ;
X`009int i,status,iosb[2],abstime[2],*ip ;
X`009int params_code[] = `123SJC$_PARAMETER_1,SJC$_PARAMETER_2,
X`009`009`009     SJC$_PARAMETER_3,SJC$_PARAMETER_4,
X`009`009`009     SJC$_PARAMETER_5,SJC$_PARAMETER_6,
X`009`009`009     SJC$_PARAMETER_7,SJC$_PARAMETER_8,
X`009`009`009     0 `125 ;
X
X`009sys$bintim(&latetime,&abstime) ;
X`009i = 0 ;
X`009dobatch[i].buflen = strlen(batch_queue) ;
X`009dobatch[i].code   = SJC$_QUEUE ;
X`009dobatch[i].bufadr = batch_queue ;
X`009dobatch[i++].retlen = 0 ;
X`009dobatch[i].buflen = strlen(f) ;
X`009dobatch[i].code   = SJC$_FILE_SPECIFICATION ;
X`009dobatch[i].bufadr = f ;
X`009dobatch[i++].retlen = 0 ;
X`009dobatch[i].buflen = 0 ;
X`009dobatch[i].code   = SJC$_NO_LOG_SPOOL ;
X`009dobatch[i].bufadr = 0 ;
X`009dobatch[i++].retlen = 0 ;
X`009dobatch[i].buflen = strlen(batch_username) ;
X`009dobatch[i].code   = SJC$_USERNAME ;
X`009dobatch[i].bufadr = batch_username ;
X`009dobatch[i++].retlen = 0 ;
X`009dobatch[i].buflen = strlen(scratch_dir) ;
X`009dobatch[i].code   = SJC$_LOG_SPECIFICATION ;
X`009dobatch[i].bufadr = scratch_dir ;
X`009dobatch[i++].retlen = 0 ;
X
X`009for ( ip=params_code ; **params ; i++ ) `123
X`009  if ( *ip == 0 ) break ;
X`009  dobatch[i].buflen = strlen( *params ) ;
X`009  dobatch[i].code = *ip++ ;
X`009  dobatch[i].bufadr = *params++ ;
X`009  dobatch[i].retlen = 0 ;
X`009`125 ;
X`009if (late) `123
X`009  dobatch[i].buflen = 8 ;
X`009  dobatch[i].code   = SJC$_AFTER_TIME ;
X`009  dobatch[i].bufadr = &abstime ;
X`009  dobatch[i++].retlen = 0 ;
X`009`125 ;
X`009dobatch[i].buflen = 0 ;
X`009dobatch[i].code   = 0 ;
X
X`009status = sys$sndjbcw(0,SJC$_ENTER_FILE,0,&dobatch,&iosb,0,0) ;
X`009return(iosb[0]) ;
X`125
X`009`009
X
Xcreate_batch_job(cmds,late,params)
Xchar **cmds,**params ;
Xint late ;
X`123
X
X`009FILE *fp ;
X`009char *cp,msg[256] ;
X`009int status ;
X
X`009cp = xmalloc(256) ;
X`009sprintf(cp,"%s%s.COM",scratch_dir,tmpnam(0)) ;
X`009if ( (fp = fopen(cp,"w")) == NULL ) `123
X`009  sprintf(msg,"Create_batch: Failure on creating %s\n",cp);
X`009  sendlogfile(msg);
X`009  return(0) ;
X`009`125 ;
X
X`009fprintf(fp,"$ SET NOON\n") ;
X`009while (*cmds != 0 ) fprintf(fp,"%s\n",*cmds++) ;
X`009if ( !( *test_mode == 'Y' `124`124 *test_mode == 'y' ) )
X`009  fprintf(fp,"$ if $STATUS then delete %s.\n",cp) ;
X`009fclose(fp) ;
X`009if ( ((status = sendbatch(cp,late,params)) & 1) == 0 )
X`009  report_error("Create_batch: Error in calling SENDBATCH",status) ;
X`009xfree(cp) ;
X`009return( status ) ;
X`125
X
X
X`012
X
X/*
X
X Tranlog simply looks in the table defined by TABLE_NAME, which defaults
Xto LNM$SYSTEM_TABLE. This can be altered by defining the system  logical
Xname  LISTSERVER_TABLE_NAME  at  startup  to  translate into the desired
Xtable name. translate a passed logical name. If successfull, it  returns
Xthe  asciz  translation of the name, if unsuccessfull, it returns a null
Xstring (in both cases, a pointer to such). It calls MALLOC() to allocate
Xthe space for the translation. Thus, care should be  excersized  in  its
Xuse.  For  example,  Generate_logicals()  initializes  a global location
Xcalled 'file_location' with a dummy allocation so  that  Generate_path()
Xcan  xfree  the previous allocation returned by Tranlog(), thus insuring
Xthat we do not run out of pagefile space sometime in  the  next  century
X(assuming we still have Vaxen 12 years from now).`032
X
X*/
X
Xchar *tranlog(s)
Xchar *s ;
X`123
X
X
X#include <lnmdef>
X
Xunion  pointer`009`123
X`009`009int  *intbuf ;
X`009`009char *charbuf ;
X`009`009`125 ;
X
Xstruct itmlst`009`123
X`009`009unsigned short int bufferlength ;
X`009`009unsigned short int item_code ;
X`009`009union pointer  addr ;
X`009`009int  *retlength ;
X`009`009`125 ;
X
X
X`009struct itmlst trnlist[2] ;
X`009struct dsc name ;
X`009char *cp ;
X`009int loglen,status ;
X`009int attr_arg ;
X
X`009cp = xmalloc( 256 ) ;
X`009name.addr = s ;
X`009name.len  = strlen(s) ;
X`009attr_arg = LNM$M_CASE_BLIND ;
X`009trnlist[0].bufferlength`009= 100 ;
X`009trnlist[0].item_code`009= LNM$_STRING ;
X`009trnlist[0].addr.charbuf`009= cp ;
X`009trnlist[0].retlength`009= &loglen ;
X`009trnlist[1].bufferlength`009= 0 ;
X`009trnlist[1].item_code`009= 0 ;
X`009status = sys$trnlnm(&attr_arg,&table_name,&name,0,&trnlist) ;
X`009if ( status == SS$_NOLOGNAM `124`124 ( status & 1 ) == 0 ) loglen = 0 ;
X`009*(cp + (loglen&255)) = 0 ;
X`009return(cp) ;
X`125
X
X
Xcreate_logical(s,equiv)
Xchar *s,*equiv ;
X`123
X`009struct item `123 short len ;
X`009`009      short code ;
X`009`009      char  *addr ;
X`009`009      int   *retlen ;
X`009`009    `125 itmlst[2] ;
X
X`009struct dsc$descriptor_s lognam ;
X
X`009lognam.dsc$w_length = strlen( s ) ;
X`009lognam.dsc$b_class  = DSC$K_CLASS_S ;
X`009lognam.dsc$b_dtype  = DSC$K_DTYPE_T ;
X`009lognam.dsc$a_pointer = s ;
X
X`009itmlst[0].len = strlen(equiv) ;
X`009itmlst[0].code = LNM$_STRING ;
X`009itmlst[0].addr = equiv ;
X`009itmlst[0].retlen = 0  ;
X`009itmlst[1].len = 0 ;
X`009itmlst[1].code = 0 ;
X
X`009return(sys$crelnm(0,&table_name,&lognam,0,&itmlst)) ;
X`125
X
X
X`012
X
X/*
XGenerate_logicals is called at startup. It builds the logical names
Xthat will be used during the image's lifetime. It may look somewhat
Xmessy, but is quite concise. \BDN
X*/
X
X
Xgenerate_logicals()
X`123
X`009int j ;
X`009char *fmt = "No translation for %s, %s used." ;
X`009char *cp ;
X
X`009j = 0 ;
X
X`009file_location  = xmalloc(2) ;`009/* Dummy allocation for now */
X`009*file_location = '\0' ;
X
X`009while ( loglist[j].log ) `123
X
X`009  cp = xmalloc( strlen(loglist[j].pro)
X`009`009     + strlen(hook_name.dsc$a_pointer)+1);
X`009  sprintf( cp,"%s%s",hook_name.dsc$a_pointer,loglist[j].pro ) ;
X`009  *loglist[j].log = cp ;
X
X`009  if ( *( *loglist[j].xla = tranlog(*loglist[j].log) ) == '\0' ) `123
X`009    *loglist[j].xla = loglist[j].def ;
X`009    cp = xmalloc( strlen(  loglist[j].def ) + strlen( fmt )
X`009 `009       + strlen( *loglist[j].log ) ) ;
X`009    sprintf( cp,fmt,*loglist[j].log,loglist[j].def ) ;
X`009    sendlogfile(cp) ;
X`009    xfree(cp) ;
X`009  `125 ;
X`009  j++ ;
X`009`125 ;
X
X`009if ( *(cp = tranlog(requests_since_boot_logical)) == '\0' )
X`009  create_logical(requests_since_boot_logical,"0") ;
X`009else
X`009  if ( ! ( *cp >= '0' && *cp <= '9' ) )
X`009    create_logical(requests_since_boot_logical,"0") ;
X`009xfree(cp) ;
X`125
X
X
X
X`012
X
X/*
X Generate_path returns a directory path to use for locating  a  file  to
Xsend out. It does so by generating a logical name based on the string`032
X
X`009'hook_name' + file_location_proto + list
X
X Given  that  *file_location_proto  = "_FILE_LOCATION_", then for a hook
Xcalled VMSSERV, the resulting  name  would  be  for  a  passed  name  of
X"VMSSERV"`032
X
X`009VMSSERV_FILE_LOCATION_VMSSERV
X
X Sys$trnlnm  will then be called to return the translated string. If the
Xlogical translation should fail, then the default name,  pointed  to  by
X'file_location_def', will be returned. This function should be called on
Xthe fly as it allows one to generate paths based on the 'list' parameter
X
X\BDN
X*/
X
Xchar *generate_path(list)
Xchar *list ;
X`123
X`009char *cp ;
X
X`009xfree( file_location ) ;
X`009cp = xmalloc( strlen(hook_name.dsc$a_pointer)
X`009`009   + strlen(file_location_proto)
X`009`009   + strlen(list) + 1 ) ;
X`009sprintf(cp,"%s%s%s",hook_name.dsc$a_pointer,file_location_proto,list);
X`009file_location = tranlog(cp) ;
X`009xfree( cp ) ;
X`009if ( *file_location == '\0' ) strcpy(file_location,file_location_def);
X`009return(file_location) ;
X`125
X
X
Xchar *generate_mail_agent(f,complex_address)
Xchar *f,*complex_address ;
X`123
X`009static char dcl_cmd[256] ;
X
X
X`009*dcl_cmd = '\0' ;
X`009if ( strcmp(internet_reply_agent,"PMDF") == 0 )
X`009  sprintf(dcl_cmd,"MAIL/SUB=\"%s\" %s %s%s%s",
X`009`009  f,f,"IN%\"\"\"",complex_address,"\"\"\"") ;
X`009  else
X`009  if ( strcmp(internet_reply_agent,"GMAIL") == 0 )
X`009    sprintf(dcl_cmd,"GMAIL/NOSELF/SUB=\"%s\" %s \"%s\"",
X`009`009    f,f,complex_address);
X`009    else sendlogfile("Unknown mailer agent specified") ;
X`009return(dcl_cmd) ;
X
X`125
X
X`012
X
Xnull_string(s)
Xchar *s ;
X`123
X`009int is_null ;
X
X`009is_null = 1 ;
X`009while ( *s ) `123 if ( !(is_null = ( *s <= ' ' )) ) break; s++ ; `125 ;
X`009return(is_null) ;
X`125
X
X
Xchar *strip(s)
Xchar *s ;
X`123
X`009char *cp,*dp ;
X`009dp = cp = s ;
X`009while (*cp) `123 if ( *cp > ' ' ) *dp++ = *cp ; cp++ ; `125 ;
X`009*dp = '\0' ;
X`009return(s) ;
X`125
X
Xchar *collapse(s)
Xchar *s ;
X`123
X`009char *cp,*dp,last_ch ;
X
X`009last_ch = '\0' ;
X`009cp = dp = s ;
X`009while (*cp) `123
X`009  if ( *cp >= ' ' )
X`009    if ( ! whitespace(*cp) ) *dp++ = *cp ;
X`009      else if ( ! whitespace(last_ch) ) *dp++ = *cp ;
X`009  last_ch = *cp++ ;
X`009`125 ;
X`009*dp = '\0' ;
X`009return(s) ;
X`125
X
Xwhitespace(c)
Xchar c ;
X`123
X`009return( c == ' ' `124`124 c == '\011' ) ;
X`125
X
X
X`012
X
Xchar *upcase(s)
Xchar *s ;
X`123
X`009char *cp ;
X`009cp = s ;
X`009while ( *cp ) `123 *cp = toupper(*cp) ; cp++ ; `125 ;
X`009return(s) ;
X`125
X
Xchar *lowcase(s)
Xchar *s ;
X`123
X`009char *cp ;
X`009cp = s ;
X`009while ( *cp ) `123 *cp = tolower(*cp) ; cp++ ; `125 ;
X`009return(s) ;
X`125
X
X
X/*`009Due to a bug in the CRTL we will have to open, FSTAT and then
X`009close. The STAT call never deassigns the I/O channel that the
X`009file is accessed on.
X*/
X
X#include`009<file>
X
Xstruct stat *getstat(f)
Xchar *f ;
X`123
X
X`009static struct stat attrs, *ret_attrs ;
X`009unsigned int file_d, f_size ;
X
X/*`009if ( stat(f,&attrs) ) return(0) ;
X`009  else return(&attrs) ; */
X
X`009if ( ( file_d = open(f,O_RDONLY,0) ) == -1 ) return(0) ;
X`009if ( fstat(file_d,&attrs) ) ret_attrs == 0 ;
X`009  else ret_attrs = &attrs ;
X`009close( file_d ) ;
X`009return( ret_attrs ) ;
X`125
X
X`012
X
X/*
X RECEIVE_FILE is called when notification of a file arrival is signaled
Xby Jnet (by awakening the process). The information returned on success
Xis:
X
X`009File:`009The filename under which the file was stored. This is
X`009`009generated as  'scratch_dir':'hook_name'.receive.  The
X`009`009senders name.type is ignored currently.  For example,
X`009`009    SYS$SYSROOT:[VMSSERV]VMSSERV.RECEIVE
X`009
X`009Host:`009The BITNET host the file came from. This is NOT a very
X`009`009useful field as the file may likely be gatewayed.
X
X`009User:`009The BITNET host's username the file came from.  Again,
X`009`009not terribly useful as the file may be gatewayed.
X
X`009Name:`009The senders filename. Ditto, may be gatewayed
X
X`009Type:`009The senders filetype. ...
X
X`009Device:`009PRT or PUN, in RSCS terminology
X
X`009Class:`009A, N or M,  in RSCS terms.
X
X The rscs file is opened to retrieve the first  record,  which  contains
Xthe  tag  information,  ie,  user,  name,  type and so on. RMS is called
Xdirectly as the author has considerable disdain  for  language  RTL  I/O
Xservices,  they  get in the way more often than not. Following this, the
Xjnet service to decode the tag record is called, followed by the call to
Xthe jnet service that processes the file. A little messy in C because of
Xthe need for building descriptors for everything. \BDN
X
X*/
X
Xreceive_file(file,host,user,name,type,device,class)
Xchar *file,*host,*user,*name,*type,*device,*class ;
X`123
X
X`009int status,mrs,out_length ,rec_error() ;
X`009struct FAB fab ;
X`009struct RAB rab ;
X`009struct XABFHC xab ;
X`009char *bp, f[80], dst[80], *cp ;
X`009unsigned int date[2],rec_cnt,spool_id ;
X
X`009int opt_append`009`009= 1 ;
X`009int opt_confirm`009`009= 0 ;
X`009int opt_fortran`009`009= 1 ;
X`009int opt_interrupt`009= 0 ;
X`009int opt_log`009`009= 0 ;
X`009int opt_special_format`009= 1 ;
X`009int opt_translate`009= 1 ;
X
X
X`009$DESCRIPTOR(d_space," ") ;
X`009$DESCRIPTOR(d_null,"") ;
X`009$DESCRIPTOR(d_dummy,"                  ") ;
X`009static struct dsc$descriptor_s
X`009   d_file = `12380,DSC$K_DTYPE_T,DSC$K_CLASS_S,0`125 ,
X`009   d_nam  = `12380,DSC$K_DTYPE_T,DSC$K_CLASS_S,0`125 ,
X`009   d_dst  = `12380,DSC$K_DTYPE_T,DSC$K_CLASS_S,0`125 ,
X`009   d_tag  = `1230 ,DSC$K_DTYPE_T,DSC$K_CLASS_S,0`125 ,
X`009   d_host = `12310,DSC$K_DTYPE_T,DSC$K_CLASS_S,0`125 ,
X`009   d_user = `12310,DSC$K_DTYPE_T,DSC$K_CLASS_S,0`125 ,
X`009   d_name = `12310,DSC$K_DTYPE_T,DSC$K_CLASS_S,0`125 ,
X`009   d_type = `12310,DSC$K_DTYPE_T,DSC$K_CLASS_S,0`125 ,
X`009   d_device = `12310,DSC$K_DTYPE_T,DSC$K_CLASS_S,0`125,
X`009   d_class  = `1232 ,DSC$K_DTYPE_T,DSC$K_CLASS_S,0`125;
X
X`009sprintf(f,"%s%s%s","JAN_SYS:",hook_name.dsc$a_pointer,".RSC.-0");
X`009sprintf(dst,"%s%s.RECEIVE",scratch_dir,hook_name.dsc$a_pointer) ;
X`009fab = cc$rms_fab ;
X`009rab = cc$rms_rab ;
X`009xab = cc$rms_xabfhc ;
X`009fab.fab$l_xab = &xab ;
X`009fab.fab$l_fna = f ;
X`009fab.fab$b_fns = strlen(f) ;
X`009rab.rab$l_fab = &fab ;
X`009if ( (status = sys$open(&fab)) & 1 ) `123
X`009  status = sys$connect(&rab) ;
X`009  mrs = (xab.xab$w_lrl & 0xfffe) + 2 ;
X`009  rab.rab$l_ubf =  ( bp = xmalloc(mrs) ) ;
X`009  rab.rab$w_usz = mrs ;
X`009  if ( ((status = sys$get( &rab )) & 1) == 0 ) return(status) ;
X
X`009  d_tag.dsc$a_pointer= bp ;
X`009  d_tag.dsc$w_length = rab.rab$w_rsz ;
X`009  d_host.dsc$a_pointer = host ;
X`009  d_user.dsc$a_pointer = user ;
X`009  d_name.dsc$a_pointer = name ;
X`009  d_type.dsc$a_pointer = type ;
X`009  d_class.dsc$a_pointer = class ;
X`009  d_device.dsc$a_pointer = device ;
X
X`009  status = jan_tagparse(&d_tag,&d_dummy,&d_dummy,&d_host,&d_user,
X`009`009`009`009&d_name,&d_type,&d_device,&d_class,&date,
X`009`009`009`009&rec_cnt,&spool_id) ;
X`009  *(host+8) = '\0' ;
X`009  *(user+8) = '\0' ;
X`009  *(name+8) = '\0' ;
X`009  *(type+8) = '\0' ;
X`009  *(class+1) = '\0' ;
X`009  *(device+5) = '\0' ;
X
X`009  if ( status & 1 ) `123
X`009    d_file.dsc$a_pointer = f ;
X`009    d_file.dsc$w_length = strlen(f) ;
X`009    d_dst.dsc$a_pointer = dst ;
X`009    d_dst.dsc$w_length  = strlen(dst) ;
X`009    d_nam.dsc$a_pointer = file ;
X`009    d_nam.dsc$w_length = 100 ;
X`009    status = jan_rec_file(&d_device,&d_file,&d_space,&d_dst,&d_dst,
X`009`009`009`009  &opt_translate,opt_log,opt_confirm,
X`009`009`009`009  &opt_special_format,&opt_fortran,&d_space,
X`009`009`009`009  &opt_append,&opt_interrupt,&rec_error,
X`009`009`009`009  &d_nam,&out_length ) ;
X`009    if ( ( status & 1 ) == 0 ) `123
X`009      cp = xmalloc(255) ;
X`009      sprintf(cp,"W Rec_file: %s %s",f,dst) ;
X`009      sendlogfile(cp) ;
X`009      xfree(cp) ;
X`009      *file = '\0' ;
X`009    `125`032
X`009    else *(file+(out_length&0xFF)) = '\0' ;`009   `032
X
X`009    delete(f) ;
X`009  `125 ;
X
X`009  sys$disconnect(&rab) ;
X`009  sys$close(&fab) ;
X`009  xfree(bp) ;
X`009
X`009`125 ;
X`009
X`009return( status ) ;
X`125
X
X`012
X
X/* Do_mail handles the mess of trying to find an address to reply
X   with mail, and then process the user commands. It's a mess.
X*/
X
Xdo_mail(f,node,user,complex_address)
Xchar *f,*user,*node,*complex_address ;
X`123
X`009int from_offset,i,mrs,n_recs,out_length,status,n_alloc,in_from ;
X`009char *ap,*bp, *cp,*from,myself[128],*is_alloc[128],*xp ;
X`009struct FAB fab ;
X`009struct RAB rab ;
X`009struct XABFHC xab ;
X
X`009from = "" ;
X`009sprintf(myself,"%s@%s",batch_username,mynode) ;
X`009*complex_address = '\0' ;
X`009fab = cc$rms_fab ;
X`009rab = cc$rms_rab ;
X`009xab = cc$rms_xabfhc ;
X`009fab.fab$l_xab = &xab ;
X`009fab.fab$l_fna = f ;
X`009fab.fab$b_fns = strlen(f) ;
X`009rab.rab$l_fab = &fab ;
X`009if ( (status = sys$open(&fab)) & 1 ) `123
X`009  status = sys$connect(&rab) ;
X`009  mrs = (xab.xab$w_lrl & 0xfffe) + 2 ;
X`009  rab.rab$l_ubf =  ( bp = xmalloc(mrs) ) ;
X`009  rab.rab$w_usz = mrs ;
X`009  n_alloc = 0 ;
X`009  n_recs = 0 ;
X`009  from_offset = 0 ;
X`009  in_from = 0 ;
X
X`009  while ( ( status = sys$get( &rab ) ) & 1 ) `123
X`009    n_recs++ ;
X`009    *(bp+rab.rab$w_rsz) = '\0' ;
X`009    lowcase(bp) ;
X`009    if ( in_from )
X`009      if ( *bp == ' ' && null_string(bp) == 0 ) `123
X`009`009cp = bp ;
X`009`009while ( *cp && *cp == ' ' ) cp++ ;
X`009`009xp = from ;
X`009`009sprintf((from=xmalloc(strlen(xp)+strlen(cp)+1)),"%s%s",xp,cp);
X`009`009is_alloc[n_alloc++] = from ;
X`009      `125
X`009      else in_from = 0 ;
X`009    if ( strncmp(bp,"from:",5) == 0 ) `123
X`009      from = is_alloc[n_alloc++] = xmalloc(mrs) ;
X`009      strcpy(from,bp) ;
X`009      from_offset = n_recs ;
X`009      in_from++ ;
X`009    `125 ;
X`009  `125 ;
X
X`009  sys$rewind(&rab) ;
X`009  if ( *from ) `123
X`009    for ( i = 0; i < from_offset; i++ ) sys$get(&rab) ;
X`009    if ( cp = strchr(from,'<') ) `123
X`009      ap = complex_address ;
X`009      cp++ ;
X`009      while ( *cp != '>' && *cp != '\0' ) *ap++ = *cp++ ;
X`009      *ap = '\0' ;
X`009    `125`032
X`009    else
X`009      if ( cp = strchr(from,' ') ) `123
X`009        while ( *cp == ' ' && *cp != '\0' ) cp++ ;
X`009        ap = complex_address ;
X`009        while ( *cp != ' ' && *cp != '\0' ) *ap++ = *cp++ ;
X`009`009while ( *cp == ' ' && *cp ) cp++ ;
X`009`009upcase(cp) ;
X`009`009if ( strchr(complex_address,'@') == 0 &&
X`009`009     strncmp(cp,"AT ",3) == 0 ) `123
X`009`009  *ap++ = '@' ;
X`009`009  while ( *cp != ' ' && *cp ) cp++ ;`009`009 `032
X`009`009  while ( *cp == ' ' && *cp ) cp++ ;
X`009`009  while ( *cp != ' ' && *cp ) *ap++ = *cp++ ;
X`009`009`125 ;
X`009        *ap = '\0' ;
X`009      `125 ;
X
X`009    while ( ( status = sys$get(&rab) ) & 1 ) `123
X`009      *(bp+rab.rab$w_rsz) = '\0' ;
X`009      if ( null_string(bp) ) break ;
X`009    `125 ;
X`009  `125
X`009  else
X`009    sprintf(complex_address,"%s@%s",user,node) ;
X
X`009  strcpy((cp = xmalloc(strlen(complex_address)+1)),complex_address) ;
X`009  if ( xp = strchr(cp,'.') ) *xp = '\0' ;
X`009  if ( strcmp(upcase(myself),upcase(cp)) == 0 )
X`009    sendlogfile("W Mail to SELF loop detected -- ignored") ;
X`009  else
X`009    while ( ( status = sys$get(&rab) ) & 1 ) `123
X`009      *(bp+rab.rab$w_rsz) = '\0' ;
X`009      if ( null_string(bp) == 0 )
X`009        if (do_mail_command(upcase(bp),complex_address) == 0) break ;
X`009  `125 ;
X`009  sys$disconnect(&rab) ;
X`009  sys$close(&fab) ;
X`009  xfree(cp) ;
X`009  xfree(bp) ;
X`009  while ( n_alloc != 0 ) xfree(is_alloc[--n_alloc]) ;
X`009`125 ;
X`009return( status ) ;
X`125
X`012
X
X/* The following defines are from $LIBVMDEF in STARLET */
X
X#define LIB$K_VM_FIRST_FIT`0091
X#define LIB$K_VM_QUICK_FIT`0092
X#define LIB$K_VM_FREQ_SIZES`0093
X#define LIB$K_VM_FIXED`009`0094
X#define LIB$M_VM_BOUNDARY_TAGS`0091
X#define LIB$M_VM_GET_FILL0`0092
X#define LIB$M_VM_GET_FILL1`0094
X#define LIB$M_VM_FREE_FILL0`0098
X#define LIB$M_VM_FREE_FILL1`00916
X#define LIB$M_VM_EXTEND_AREA`00932
X
X
Xstatic unsigned int zone_id = 0 , zone_init = 0 ;
Xstatic unsigned int alloc_type,alloc_arg,alloc_flags ;
X
Xchar *xmalloc(size)
Xunsigned int size ;
X`123
X
X`009unsigned int base ;
X`009int status ;
X
X`009if ( zone_init == 0 ) `123
X`009  alloc_type  = LIB$K_VM_QUICK_FIT ;
X`009  alloc_arg   = 8 ;
X`009  alloc_flags = LIB$M_VM_BOUNDARY_TAGS
X`009`009      `124 LIB$M_VM_GET_FILL0
X`009`009      `124 LIB$M_VM_FREE_FILL0 ;
X
X`009  status = lib$create_vm_zone( &zone_id,&alloc_type,&alloc_arg,
X`009`009`009`009       &alloc_flags,0,0,0,0,0,0) ;
X`009  zone_init++ ;
X`009  if ( ( status & 1 ) == 0 ) report_error("Create_Vm_Zone",status) ;
X`009`125 ;
X
X`009if ( (( status = lib$get_vm(&size,&base,&zone_id) ) & 1 ) == 0 )
X`009  report_error("Lib$Get_Vm failed",status) ;
X`009return(base) ;
X`125
X
Xxfree(base)
Xunsigned int base ;
X`123
X`009int status ;
X
X`009status = lib$free_vm(0,&base,&zone_id) ;
X`009if ( ( status & 1 ) == 0 ) report_error("Lib$Free_Vm",status) ;
X`125
X
X
Xrec_error(s)
Xstruct dsc *s ;
X`123`125
X
X
X`012
X
X
X/* DO_PACKAGE is called from sendfile() and send_mail_file() to check
Xif the requested file is a  PACKAGE file.  This is a special class of
Xfile that  contains all the filenames needed to completely define all
Xthe files needed to build an application. A sample $package file:
X
X* VMSTPC.$PACKAGE
X*
X* package definition for VMSTPC (tape copy)
X
XVMSTPC.$PACKAGE
XVMSTPC.C
XVMSTPC.COM
XVMSTPC.CLD
X`032
X
X
X So the action taken when the filetype is found is to open the package
Xfile, scan for a line not starting with *, and then pass the filenames
Xback  to the caller one by one.  Note that  these are recursive calls,
Xthus nested packages should work.
X
X*/
X
Xchar *last_package = "" ;
X
Xdo_package(s,node,user,type)
Xchar *s,*node,*user ;
Xint type ;
X`123
X`009char *cp,*dp,f[256],buff[256] ;
X`009FILE *fp ;
X
X`009strcpy(buff,s) ;
X`009if ( cp = strchr(buff,'.') )
X`009  if ( strncmp(cp,".PACKAGE",strlen(".PACKAGE")) == 0 ) `123
X
X `009    if ( strcmp(last_package,buff) == 0 ) return(0) ;
X`009    *cp = '\0' ;
X`009    sprintf(f,"%s%s.$%s",generate_path(list_name),buff,++cp) ;
X`009    if ( *expand_name(buff,f) == '\0' ) strcpy(buff,f) ;
X`009    if ( ( fp = fopen(buff,"r") ) == NULL ) `123
X`009      sprintf(f,"W %s package file requested, not found",buff);
X`009      sendlogfile(f) ;
X`009      return(PACKAGE_FNF) ;
X`009    `125`032
X`009    else `123
X
X`009      while ( (cp = fgets(buff,256,fp)) != NULL ) if (*cp != '*') break ;
X`009      if ( cp == NULL ) `123
X`009`009sprintf(buff,"W %s has invalid format",f) ;
X`009`009sendlogfile(buff) ;
X`009`009fclose(fp) ;
X`009`009return(PACKAGE_COMPLETED) ;
X`009      `125 ;
X  `009      strcpy((last_package=xmalloc(256)),s) ;
X
X`009      while ( cp != NULL ) `123
X`009`009if ( null_string(collapse(cp)) == 0 ) `123
X`009`009  sprintf( (dp = xmalloc(256)) ,"%s %s",send_types[type],cp) ;
X`009`009  if ( *node ) do_command(node,user,dp) ;
X`009          else do_mail_command(dp,user) ;
X`009`009  xfree(dp) ;
X`009`009`125 ;
X`009`009cp = fgets( buff,256,fp ) ;
X`009      `125 ;
X`009      fclose(fp) ;
X`009      xfree( last_package ) ;
X`009      last_package = "" ;
X`009      return(PACKAGE_COMPLETED) ;
X`009    `125 ;
X
X`009  `125 ;
X`009return(PACKAGE_NOTFOUND) ;
X`125
X
$ GOSUB UNPACK_FILE

$ FILE_IS = "VMSSERV.RNO"
$ CHECKSUM_IS = 873701836
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X.if help
X.rm 75`032
X.lm 1
X.no paging
X.no flags lowercase
X.flags accept
X.endif help
X.if doc
X.date
X.enable bar
X.flags accept
X.flags bold
X.no flags index
X.flags substitute
X.style headers 6,1,6,7,7,1,1,1,2
X.display levels d,d,ll
X.left margin 2
X.right margin 74
X.no autosubtitle
X.no number
X.page size 58,76
X.set paragraph 1,1,1
X.test page 1
X.title VMSSERV
X.subtitle VAX/VMS File Server
X.no headers`032
X.figure 10
X.right;A User's Guide To VMSSERV
X.blank 1
X.right;The VAX/VMS File Server
X.blank 6
X.right;James R. Gerland`032
X.blank 2
X.right;University Computing Services
X.right;Computer Center
X.right;State University of New York at Buffalo
X.right;Buffalo, New York 14260 USA
X.blank 2
X.right;Document Number: UCS-VMS-002
X.blank 4
X.right;Revised - $$date
X.blank 4
X.right;Copyright 1988
X.break
X.right;University of Toledo
X.break
X.right;State University of New York at Buffalo
X.blank
V.lm+26;This program may be not copied or distributed without the permission o
Xf
Xthe authors.
X.lm-26
X.page
X.headers on
X.page
X.send toc .no number
X.send toc .page size 58,76
X.send toc .flags substitute
X.send toc .date
X.send toc .blank 3
X.endif doc
X.if doc
X.number page
X.require "Disk$Acsdisk2:[Acs0.Util.Vmsserv]Vmsserv.Rnt"
X.endif doc
X.if doc
X.page
X.header level 1 OVERVIEW`032
X.blank
XVMSSERV is a program which permits a user on a remote node to retrieve`032
Vpublicly available files. VMSSERV requires VAX/VMS 4.+ and Jnet V2 or later.
X `032
X.blank
XThe user communicates with VMSSERV using a small vocabulary of commands.
VThese commands can be sent to VMSSERV either as interactive messages or via`0
X32
Vvalid RFC822 format memos.  Commands sent via mail are included in the body o
Xf`032
Vthe memo, not in the  Subject: line.  A memo may contain more than one comman
Xd`032
Xas long as there is only one command per line.
X.blank
VVMSSERV provides file service similar to that provided by LISTSERV on IBM VM`
X032
Xsystems.
VCurrently, VMSSERV acts only as a file server.  There are no plans at this ti
Xme
Xto include any list serving features.
X.blank
X.endif doc
X.if help
X.i-1;1 VMSSERV
X.break
XVMSSERV is a utility which runs as a detached process under VAX/VMS 4.+
Xand Jnet V2 or later.  VMSSERV understands a limited set of commands which
Xcan be sent to it either as interactive messages or via valid RFC822 mail.
XThe current list of commands VMSSERV understands is listed below.  All`032
Xcommands sent via mail must be included in the body of the mail, not in the
XSubject: line.  A mail message may contain more than one command as long as
Xthere is only one command per line.
X.blank
VCurrently, VMSSERV acts only as a file server.  There are no plans at this ti
Xme
Xto include any list serving features.
X.break
X.endif help
X.if doc
X.blank
X.header level 1 Using VMSSERV
X.header level 2 Commands
X.blank
X.endif doc
X.if help
X.i-1;2 Commands
X.break
X.endif help
XVMSSERV currently understands the following commands which may be abbreviated
Xto the upper case portion in this list:
X.blank
XDIRectory [file-spec]######Return a list of files available
X.blank
XGET [file-spec]############Synonym for SENDME
X.blank
XHELP#######################Return a list of valid commands
X.blank
XINDex [file-spec]##########Return a files called 'file-spec' FILELIST
X.blank
XSENdme [file-spec]#########Return a file
X.blank
XSTATUS ####################Return status information (Interactive only)
X.blank
XVMSdump [file-spec]########Return a file in VMSDUMP format.  Recommended
X.break
X###########################for transferring files (especially binary)
X.break
X###########################to another VAX/VMS system running`032
X.break
X###########################Jnet V2 or later.
X.blank
XPUNch [file-spec]##########Return a file in IBM Punch format
X.blank
X?##########################Synonym for HELP
X.blank
X.if doc
X.blank
X.header level 2 Transferring Binary Files
X.blank
X.endif doc
X.if help
X.i-1;2 Binary__Files
X.break
X.endif help
VYou can transfer binary files (.EXE, .TSK, .SAV) to a remote system only if`0
X32
Xyou are running Jnet V2 or later system.  These files must be transferred
Xwith the VMSDUMP command.  For example,`032
X.blank    `032
X_$ SEND VMSSERV@UBVMSD VMSDUMP MAKE.EXE
X.blank    `032
VVMSDUMP is recommended for all requests from Jnet nodes as it protects you`03
X2
Xfrom any non-standard character set conversion.
X.blank    `032
X.if doc
X.blank
X.header level 2 VMS File Specifications
X.blank
X.endif doc
X.if help
-+-+-+-+-+ End of part 3 +-+-+-+-+-
