From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 10-FEB-1989 07:26
To:	MRGATE::"ARISIA::EVERHART"
Subj:	VMS_SHARE (Version 6.10) 2/4


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu,  9 FEB 89 11:51:00 PDT
Received: from CUNYVM.CUNY.EDU by KL.SRI.COM with TCP; Thu, 9 Feb 89 11:46:27 PST
Received: from UKACRL.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.1) with BSMTP id 8686; Thu, 09 Feb 89 14:18:05 EST
Received: from RL.IB by UKACRL.BITNET (Mailer X1.25) with BSMTP id 5893; Wed,
 08 Feb 89 13:37:10 GMT
Received: from RL.IB by UK.AC.RL.IB (Mailer X1.25) with BSMTP id 5758; Wed, 08
          Feb 89 13:37:09 GM
Via:      UK.AC.KCL.CC.OAK;  8 FEB 89 13:36:53 GMT
Date:     8-FEB-1989 13:36:27 GMT
From:     UDAA055%OAK.CC.KCL.AC.UK@CUNYVM.CUNY.EDU
To:       info-vax@KL.SRI.COM
Subject:  VMS_SHARE (Version 6.10) 2/4
Sender:   JANET "UDAA055@UK.AC.KCL.CC.OAK" <UDAA055%OAK.CC.KCL.AC.UK@CUNYVM.CUNY.EDU>
Mailer:   Janet_Mailshr V3.3 (14-Dec-1988)

+-+-+-+ Beginning of part 2 +-+-+-+
X$! Copyright (c) 1987, by Michael Bednarek
X$! The distribution of this file is unrestricted as long as this notice
X$! remains intact.
X$! Credits: SLOANE@UKANVAX@BITNET (Bob Sloane) for the idea of
X$!          escaping control characters.
X$!
X$! Copyright `169 1988, by James Gray
X$! The distribution of this file is unrestricted as long as these notices
X$! remain intact.
X$!
X$!++---------------------------------------------------------------------
X$! Usage: @VMS_SHARE file[,file...] sharfile
X$!`009where:
V$!`009file[,file...]`009are file names, separated by commas, possibly includi
Xng
X$!`009`009`009wild-card characters, of those files that are to be
X$!`009`009`009packaged.
X$!`009sharefile`009is the resulting self-unpacking archive file.
X$!
V$! To turn on verification, define the logical name SHARE_VERIFY to have a va
Xlue
X$! of 1.  If it is undefined, or has a null/zero value, then verification is
X$! off.  Verification is also off if the user has no read access.
X$!
X$! The resulting sharefile will be written in as many parts as is necessary
V$! to keep the size of any one part from being greater than SHARE_MAX_PART_SI
XZE.`032
V$! By default SHARE_MAX_PART_SIZE is 31 blocks.  The user may define a logica
Xl
X$! name of the same name to override the default.  The minimum
X$! SHARE_MAX_PART_SIZE is 8 blocks.
X$!
V$! The resulting sharefile(s) will have a file type of .n_OF_m if no file typ
Xe
X$! was specified or will have _n_OF_m appended to the file type; this is true
X$! even if the sharefile fits in one part.
X$!
X$! All parts of the sharefile will be within a few characters of the maximum
X$! part size.  Input files may (and probably will) be split between parts.
X$! To unpack files, simply cut the text preceeding the second dotted line,
V$! copy all files into a single file and then execute (@) that file.  Checksu
Xms
X$! are based on the input files and not on the parts.  It is unnecessary to
X$! remove possible garbage characters at the end of each part.
X$!
X$! Input files can be of any length and can span one or more sharefile parts.
X$! (NOTE: This is the original reason for writing this new version.)
X$!
X$! The TPU unpacking code, while left intact in this file for readability, is
X$! packed into 80 (or less) character lines in the sharefile to minimize the
X$! size of the sharefile.
X$!
X$! As with the original VMS_SHAR, this procedure will escape all characters
X$! not in the ASCII range blank (0x20 or 32) to `126 (0x7E or 126).
X$!
X$! Required: VAX/VMS version 4.4 or higher
X$!--
X$!+
X$! Get the user's USERNAME and the parameters if not already specified.
X$!-
X$ USER = F$EDIT( F$GETJPI( "", "USERNAME" ), "COLLAPSE" )
X$ IF F$TRNLNM( "SHARE_REAL_NAME" ) .NES. "" THEN -
X`009USER = USER + " (" + F$TRNLNM("SHARE_REAL_NAME") + ")"
X$ SAY = "WRITE SYS$OUTPUT"
X$ SAY FACILITY_NAME, " ", FACILITY_VERSION
X$ SAY ""
X$ IF P1 .EQS. "" THEN INQUIRE P1 "_File(s) to package"
X$ IF P1 .EQS. "" THEN EXIT SS$_ABORT
X$ IF P2 .EQS. "" THEN INQUIRE P2 "_SHARE file"
X$ IF P2 .EQS. "" THEN EXIT SS$_ABORT
X$ FILE_LIST = P1
X$ SHARE_FILE = F$PARSE( P2 ) - ";"
X$!+
X$! Determine the maximum part size to use.
X$!-
V$ IF MAX_PART_SIZE .LE. 8 THEN MAX_PART_SIZE = 31`009`009!  the maximum size
X of each part.
X$ SAY "SHARE_MAX_PART_SIZE is defined as ", MAX_PART_SIZE, " blocks (", -
X`009MAX_PART_SIZE * 512, " bytes)."
X$!+
V$! Scan the list of supplied files to pack making sure that each one can be f
Xound.
X$!-
X$ SAY ""
X$ BEL[0,7] = 7
X$ INDEX = -1
X$ FILE_COUNT = 1
X$NEXT_ELEMENT:
X$ FILE_COUNT = FILE_COUNT - 1
X$ INDEX = INDEX + 1
X$ ELEMENT = F$ELEMENT( INDEX, ",", FILE_LIST )
X$ IF ELEMENT .EQS. "," THEN GOTO ELEMENTS_DONE
X$ PREVIOUS_FILE = "no file"
X$NEXT_FILE:
X$ FILE_COUNT = FILE_COUNT + 1
X$ FILE'FILE_COUNT = F$SEARCH( ELEMENT )
X$ IF FILE'FILE_COUNT .EQS. PREVIOUS_FILE THEN GOTO NEXT_ELEMENT
X$ IF FILE'FILE_COUNT .NES. "" THEN GOTO LOOK
X$ IF PREVIOUS_FILE .EQS. "no file" THEN -
X`009SAY "%VMS_SHARE-I-FNF, file not found: ", ELEMENT
X$ GOTO NEXT_ELEMENT
X$LOOK:
X$ PREVIOUS_FILE = FILE'FILE_COUNT
X$ SAY "Looking at ", File'FILE_COUNT
V$ IF F$ELEMENT( 0, ";", FILE'FILE_COUNT ) .NES. SHARE_FILE THEN GOTO NOT_SHAR
XE_FILE
X$ SAY "You can't have your SHARE file among the input files!"
X$ EXIT SS$_ABORT
X$NOT_SHARE_FILE:
X$ GOTO NEXT_FILE
X$ELEMENTS_DONE:
X$!+
X$! Check that there is at least one input file.
X$!-
X$ IF FILE_COUNT .GT. 0 THEN GOTO SOME_FILES
X$ SAY "%VMS_SHARE-W-SEARCHFAIL, error searching for ", P1
X$ SAY "-VMS_SHARE-E-FNF, file not found.  No file to package.  Nothing done."
X$ EXIT SS$_ABORT
X$SOME_FILES:
X$!+
X$! Write the file that will be used as input to TPU.
X$!-
X$ OPEN/WRITE VMS_SHARE_DUMMY VMS_SHARE_DUMMY.DUMMY
V$ WRITE VMS_SHARE_DUMMY """''USER'"" ""''MAX_PART_SIZE'"" ""''FILE_COUNT'"" "
X"''SHARE_FILE'"""
X$ INDEX = 0
X$NEXT_NAME:
X$ INDEX = INDEX + 1
X$ NAME = F$PARSE( FILE'INDEX )
X$ SAY "Checksumming ", File'INDEX
X$ CHECKSUM 'NAME
X$ WRITE VMS_SHARE_DUMMY """''NAME'"" ""''CHECKSUM$CHECKSUM'"""
X$ IF INDEX .LT. FILE_COUNT THEN GOTO NEXT_NAME
X$ CLOSE VMS_SHARE_DUMMY
X$ SAY ""
X$ SAY "Packing files into SHARE file(s) ''SHARE_FILE'"
X$ SAY ""
X$ IF .not. (verify .or. display) THEN $ DEFINE/USER_MODE SYS$OUTPUT NL:
X$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/NOSECTION VMS_SHARE_DUMMY.DUMMY
X!=====================================================================
X!     V M S _ S H A R E
X!
X! Function:
X!    Take a series of ASCII files and package them into a self-unpacking
X!    command procedure that can be sent relatively undamaged thru the
X!    electronic mail system.  Once received, the procedure can be run
X!    to produce exact copies of the original text files.
X!
X! Restrictions:
X!    File attributes (in particular - record attributes) are not
X!    preserved.
X!
X!    Because it is impossible to provide a line by line protocol with
X!    automatic resend of damaged lines, we rely on the mailer to get
X!    each line there undamaged. Missing lines cannot be recovered nor
X!    can recovery be effected if the DCL or TPU code that controls the
X!    unpacking is damaged in any way.
X!
X!======================================================================
X
X
X!+
X! Generate a pattern that contains all of the ASCII characters except`032
X! the printable characters in the range 32 to 126. These will be used
X! to determine characters which need to be escaped. Also build a string
X! containing the complete ASCII set. We use this to generate 'escape'
X! sequences.
X!
X! Because the network performs obscure translations on certain of the`032
X! printable characters, we add them to the pattern string in order to
X! force them to be escaped, thus allowing them to survive the journey across
X! hostile systems.
X!`009`009`009`009`009`009Andy Harper, 6-DEC-1988
X!-
XPROCEDURE INIT_ASCII
XLOCAL i_ascii;`009! Loop counter to set up strings and ascii codes
X
X   ! String to contain all unprintable or troublesome characters
V   s_control := ASCII( 94) + ASCII(123) + ASCII(124) + ASCII(125) + ASCII(126
X);
X
X   s_ascii := ""; `009`009! String to contain all ASCII characters
X   i_ascii := 0;  `009`009! Loop counter for building the ASCII code patterns
X
X   LOOP
X
X     s_ascii := s_ascii + ASCII( i_ascii );
X     IF ( i_ascii < 32 ) OR ( i_ascii > 126 ) THEN
X       s_control := s_control + ASCII( i_ascii );
X     ENDIF;
X
X     i_ascii := i_ascii + 1;
X     EXITIF i_ascii > 255;
X
X   ENDLOOP;
X
X   ! Generate a pattern for ALL control characters or troublesome printables
X   pat_control := ANY( s_control );
X
XENDPROCEDURE;
X
X
X!+
X!  Procedure to add a line of text to the output; a newline is also added.
X!-
XPROCEDURE __copy_text( ss_string )
X
X  COPY_TEXT( ss_string);
X  SPLIT_LINE;
X
XENDPROCEDURE;
X
X
X!+
X! Returns the buffer pointer of an existing buffer or, if the buffer does not
X! exist, returns 0.
X!-
XPROCEDURE __find_buffer (s_buffer_name)
XLOCAL
X    b_buffer,`009`009! Buffer pointer.
X    b_next_buffer,`009! Next buffer from the list of known buffers.
X    s_name;`009`009! Uppercase form of the supplied buffer name.
X
X
X  s_name := s_buffer_name;
X  CHANGE_CASE( s_name, UPPER );
X
X  b_next_buffer := GET_INFO( BUFFERS, 'first' );
X  LOOP
X
X    EXITIF b_next_buffer = 0;`009`009`009`009! No more known buffers
X    EXITIF s_name = GET_INFO( b_next_buffer, 'name' );`009! The one we want?
X    b_next_buffer := GET_INFO( BUFFERS, 'next' );`009! Move to next buffer
X
X  ENDLOOP;
X
X  RETURN( b_next_buffer );`009`009! return pointer to buffer or 0
XENDPROCEDURE
X
X
X
X!+
X! Determine where in the buffer the current part should end, by computing the
X! size until we hit the maximum.
X!-
XPROCEDURE __find_part_end
XLOCAL ii_length, ii_line_length;`009`009! Size of lines and part
X
X  MOVE_HORIZONTAL( -CURRENT_OFFSET );
V  ii_length := LENGTH( s_part_goto ) + LENGTH( s_part_end ) + LENGTH( s_part_
Xbegin ) + LENGTH( s_part_label );
X
X  LOOP
V    EXITIF ( MARK( NONE ) = END_OF( b_packed ) ) OR ( ii_length >= i_max_part
X_bytes );
X    ii_line_length := LENGTH( CURRENT_LINE ) + 2;
X    IF ( ii_line_length - ( ( ii_line_length / 2 ) * 2 ) ) <> 0
X    THEN
X      ii_line_length := ii_line_length + 1;
X    ENDIF;
X    ii_length := ii_length + ii_line_length;
X    MOVE_VERTICAL( 1 );
X  ENDLOOP;
X  IF ii_length >= i_max_part_bytes
X  THEN
X    MOVE_VERTICAL( -1 );
X  ENDIF;
X
XENDPROCEDURE;
X
X
X
X
XPROCEDURE __get_quoted_string
XLOCAL i_offset, ss_string;
X
X  POSITION( END_OF( SEARCH( s_quote, FORWARD, EXACT ) ) );
X  MOVE_HORIZONTAL( 1 );
X  i_offset := CURRENT_OFFSET;
X  POSITION( END_OF( SEARCH( s_quote, FORWARD, EXACT ) ) );
X  ss_string := ERASE_CHARACTER( -( CURRENT_OFFSET - i_offset ) );
X  COPY_TEXT( ss_string );
X  MOVE_HORIZONTAL( 1 );
X  RETURN( ss_string );
X
XENDPROCEDURE;
X
X
X
X
X!+
X! Procedure to pack lines of TPU into a small space by removing superfluous
X! blanks and newlines chars. We ensure that each line fits into the defined
X! maximum line size and is split only upon recognized characters.
X!
X! Procedure is entered with the character string to be added. The buffer
X! remains positioned atthe last character before and after.
X!
X! Note, no attempt is made to deal with quoted strings even though TPU will
X! object if quoted strings are split across lines during unpacking.  It is
X! thought that careful programming of the code being packed should stop
X! this happening (The simplest method is to avoid the use of pattern
X! separators inside quoted strings).
X!`009`009`009`009Rewritten 24-OCT-1988 by Andy Harper
X!-
XPROCEDURE __pack_text( ss_string )
XLOCAL s_temp, i_temp;
X  !+
X  ! This is the basic function of the procedure- Compress the spurious blanks
X  ! and add the string to the buffer.
X  !-
X  s_temp := ss_string;
X  EDIT( s_temp, TRIM, COMPRESS );`009! Remove superfluous blanks
X  COPY_TEXT( s_temp );`009`009`009! Add new string to buffer
X  COPY_TEXT( s_blank );`009`009`009! Add a separator
X
X `032
X
X  !+
X  ! Find a convenient split point, if necessary.
X  !-
X  i_temp := CURRENT_OFFSET;
X  LOOP
X
X     EXITIF CURRENT_OFFSET <= i_max_line;
X     MOVE_HORIZONTAL(-1);
X     POSITION( SEARCH( pat_separator, REVERSE, EXACT ) );
X
X
X     IF CURRENT_OFFSET = i_temp THEN
V        MESSAGE("--- INTERNAL VMS_SHARE ERROR --- stuck finding wrap point!")
X;
X        MESSAGE("*** LINE: " + CURRENT_LINE );
X        MESSAGE("      AT: " + STR(CURRENT_OFFSET) );
X     ENDIF;
X     EXITIF CURRENT_OFFSET = i_temp;
X
X     i_temp := CURRENT_OFFSET;
X  ENDLOOP;
X  !+
X  ! Exit with current position on the pattern separator at the split-point
X  ! (or the end of line if there isnt one!)
X  !-
X
X
X
X  !+
X  ! If we started with a long line, then split it now.
X  !-
X  IF CURRENT_OFFSET < LENGTH( CURRENT_LINE ) THEN SPLIT_LINE;  ENDIF;
X
X
X
X  !+
X  ! Finally, reposition at last char in buffer so we are OK for next time.
X  !-
X  POSITION( END_OF( CURRENT_BUFFER ) );
X  MOVE_HORIZONTAL( -1 );
X
XENDPROCEDURE;
X
X
X
X!+
X! This procedure erases the current character from the buffer and replaces
X! it by an escaped form - `096nnn - where nnn is the ascii code of the
X! character. nnn is always exactly 3 digits
X!`009`009`009`009`009`009Andy Harper, 19-OCT-1988
X!-
XPROCEDURE QUOTE_CHAR;
X
X  COPY_TEXT(s_quoting_char+FAO("!3ZL",INDEX(s_ascii,ERASE_CHARACTER(1))-1));
X
XENDPROCEDURE;
X
X
X
X
X!+
X!  This procedure searches the named buffer for a pattern and replaces the
X!  first character in that pattern by its 'escaped' form.
X!`009`009`009`009`009`009Andy Harper, 25-OCT-1988
X!-
XPROCEDURE QUOTE_BUFFER( bb_name, pat_search)
XLOCAL r_x;
X
X   !+
X   ! We use an error handler here to catch the fact that TPU always
X   ! gives an error message if SEARCH fails to find a string, as of
X   ! course it will do when the whole buffer has been processed. This
X   ! prevents any message being given.
X   !-
X   ON_ERROR
X      IF ERROR = TPU$_STRNOTFOUND THEN RETURN; ENDIF;
X      MESSAGE("*** UNEXPECTED ERROR AT LINE " + STR( ERROR_LINE ) );
X   ENDON_ERROR;
X
X
X   POSITION( BEGINNING_OF( bb_name ) );
X   LOOP
X      r_x := SEARCH( pat_search, FORWARD, EXACT );
X      EXITIF r_x = 0;
X      POSITION( r_x );
X      QUOTE_CHAR;
X   ENDLOOP
X
XENDPROCEDURE;
X
X
X!+
X! Break all lines longer than i_max_line into lines less than or equal to
X! i_max_line.
X!
X! If breaking a line would leave trailing blanks, then carry up to 3 to
X! the next line and escape the remaining one on the line. Carrying three
X! across, plus the one that is escaped, should leave exactly enough room
X! to insert the 4-character escaped blank!  Less than four consecutive
X! trailing blanks are carried across to the next line as is.  If there
X! are more than four, then carry a maximum of three across and escape the`032
X! fourth.
X!
X! With this method, NO line should end with a trailing blank. We can`032
X! therefore safely trim off any found at the unpacking stage, thus
X! confounding mailers that might add them in along the way!
X!                                             Andy Harper, 25-OCT-1988
X!-
X
XPROCEDURE WRAP_AND_PREFIX_LINES( bb_file )
XLOCAL n_c;
X
X  POSITION( BEGINNING_OF( bb_file ) );
X  LOOP`009`009`009`009`009`009! All lines longer than i_max_line
X    IF LENGTH( CURRENT_LINE ) > i_max_line THEN`009! characters are
X      COPY_TEXT( s_long_line );`009`009`009! prepended with a "V"
X      MOVE_HORIZONTAL( i_max_line );
X`032
X      n_c :=4;
X      LOOP
X        MOVE_HORIZONTAL(-1);`009`009`009! Backup to test prev char
X        EXITIF CURRENT_CHARACTER <> ' ';`009! Non-blank found, exit
X        n_c := n_c-1;
X        EXITIF n_c = 0;`009`009`009`009! Tested all we need to?
X      ENDLOOP;
X
X      IF n_c = 0 THEN`009`009`009`009! If all are blank..
X         QUOTE_CHAR;`009`009`009`009! Replace first by quoted version
X      ELSE
X         MOVE_HORIZONTAL(1);`009`009`009! Reposition after non-blank
X      ENDIF;
X    `009`009`009`009`009`009! Remaining blanks carried
X    `009`009`009`009`009`009! over to next line
X
-+-+-+-+-+ End of part 2 +-+-+-+-+-

