From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 10-AUG-1989 16:50
To:	MRGATE::"ARISIA::EVERHART"
Subj:	VMS_SHARE (7.1-004) 3/8

Message-Id:  <8908102010.AA00292@crdgw1.ge.com>
Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu, 10 AUG 89 11:47:58 PDT
Received: from NSFnet-Relay.AC.UK by KL.SRI.COM with TCP; Thu, 10 Aug 89 11:29:53 PDT
Received: from oak.cc.kcl.ac.uk by NSFnet-Relay.AC.UK   via Janet with NIFTP
           id aa09530; 10 Aug 89 18:18 BST
Date: 		Thu, 10 AUG 89 18:17:56 GMT
From: UDAA055%oak.cc.kcl.ac.uk@NSFnet-Relay.AC.UK
To: info-vax <@NSFnet-Relay.AC.UK:info-vax@kl.sri.com>
Subject:        VMS_SHARE (7.1-004) 3/8
Sender: "JANET UDAA055@UK.AC.KCL.CC.OAK" <UDAA055%oak.cc.kcl.ac.uk@NSFnet-Relay.AC.UK>
Mailer:         Janet_Mailshr V3.4 (23-May-1989)

-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+
X   FAC_unpack     := "UNPACK";`009`009! Facility name of unpack code
X
X   DEBUG_state    := 0;`009`009`009! Turn debugging ON/OFF
X   Max_Line_Length:= 77;`009`009! Maximum length of coded/packed lines
X   Max_Parts      := 999;`009`009! Maximum number of parts supported
X
X   SPLIT_disallowed   := 0;`009`009! Flags for dealing with part breaks
X   SPLIT_permit_goto  := 1;
X   SPLIT_inhibit_goto := 2;
X
X   FAO_end_goto   := "$ GOTO PART!UL";`009! Format strings for part separato
Vrs
X   FAO_start_label:= "$PART!UL:";
X   FAO_end_part   := "+-+-+-+-+-+-+-+-  END  OF PART !UL +-+-+-+-+-+-+-+-";
X   FAO_start_part := "-+-+-+-+-+-+-+-+ START OF PART !UL -+-+-+-+-+-+-+-+";
X                     `032
X   TPU_Max_Record_Length := 960;`009! Max record length TPU supports
X
X   TPU_separators := "&(),=;>@";`009! Split packed TPU code on these
X
X   Quote_Flag := "`096";`009`009`009! Flag for escaping troublesome chars
X
X   Flag_Initial_Line      := "X";`009! Flag first line of a long line
X   Flag_Continuation_Line := "V";`009! Flag continuation lines.
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! + Initialisation routine to set up tables                            +
X! +                                                                    +
X! + This routine sets up global tables that are used to perform various+
X! + conversions on the characters in the files:                        +
X! +                                                                    +
X! +    ASCII_CHARS:     A table of ascii characters, used for mapping  +
X! +                     characters into their 'escaped' form.          +
X! +                                                                    +
X! +    NON_PRINTABLES:  A table of characters which have no visible    +
X! +                     representation. Used for determining which     +
X! +                     characters to 'escape'.                        +
X! +                                                                    +
X! +    TROUBLE_CHARS:   Characters which may get randomly converted on +
X! +                     passing thru the network and which therefore   +
X! +                     will need 'escaping'.                          +
X! +                                                                    +
X! +--------------------------------------------------------------------+
X
XPROCEDURE Init_Tables
XLOCAL c;
X
X  c := 0;
X  ascii_chars    := "";`009`009`009! Table of ASCII characters
X  Non_Printables := "";`009`009`009! Table of non-printing chars
X
X  LOOP
X    EXITIF C > 255;
X    ascii_chars := ascii_chars + ASCII(c);
X
X    IF (c < 32) OR (c > 126)
X      THEN
X         Non_Printables := Non_Printables + ASCII(c);
X    ENDIF;
X    c:=c+1;
X  ENDLOOP;
X   `032
X  Trouble_chars :=`009`009`009! Troublesome characters
X                   ASCII(91)`009`009! Left square bracket
X                 + ASCII(93)`009`009! Right square bracket
X                 + ASCII(94)`009`009! Caret
X                 + ASCII(123)`009`009! Left curly bracket
X                 + ASCII(124)`009`009! Vertical bar
X                 + ASCII(125)`009`009! Right curly bracket
X                 + ASCII(126)`009`009! Tilde
X                ;
X
X  Funny_Chars := Non_Printables + Trouble_Chars + Quote_Flag;
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! +                                                                    +
X! +  GENERAL UTILITY ROUTINES:                                         +
X! +                                                                    +
X! +     Inform(Xsev,Xident,Xtext);                                     +
X! +        Output error message in usual VMS format                    +
X! +                                                                    +
X! +     Size_Buffer(Xbuffer);                                          +
X! +        Returns the size in bytes of an arbitrary buffer. The       +
X! +        routine estimates the amount of disk space the buffer       +
X! +        would occupy if written to a file.  Ends of lines count as  +
X! +        three characters here. This is a slight overestimate in     +
X! +        practice but suffices.                                      +
X! +                                                                    +
X! +     Write_Part(Xbuffer,Part);                                      +
X! +        Writes an arbitrary buffer to a file. The current share file+
X! +        name is selected and the current 'part' number appended to  +
X! +        the filename (eg. X.SHARn)                                  +
X! +                                                                    +
X! +     Move_Info(FromBuf,ToBuf);                                      +
X! +        Shorthand for moving all info from one buffer to another    +
X! +                                                                    +
X! +     Copy_Line(Xstring);                                            +
X! +        Adds a string to the current buffer and follows it with a   +
X! +        new line character.                                         +
X! +                                                                    +
X! +     Reuse_Buffer(Xbuffer)                                          +
X! +        Erase buffer contents and position to it.                   +
X! +                                                                    +
X! +                                                                    +
X! +--------------------------------------------------------------------+
X
X
X
XPROCEDURE Inform(Xsev,xident,Xtext)
XLOCAL prefix;
X
X  prefix := "%" + FAC_name + "-" + Xsev + "-" + Xident;
X  MESSAGE( prefix + ", " + Xtext);
X
XENDPROCEDURE;
X
X
X `032
XPROCEDURE Size_Buffer(Xbuffer)
XLOCAL Size_Chars, Size_Lines;
X
X   Size_Chars := LENGTH(CREATE_RANGE(BEGINNING_OF(Xbuffer),END_OF(Xbuffer),N
VONE));
X   Size_Lines := GET_INFO(Xbuffer,"RECORD_COUNT");
X   RETURN( Size_Chars + 3 * Size_Lines );
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Write_Part(Xbuffer,Part)
XLOCAL f,r;
X
XON_ERROR
X  Inform("E","FILWRERR", "Error writing part to file " + f);
XENDON_ERROR;
X
X   f := Share_File+STR(Part);
X   WRITE_FILE(Xbuffer,f);
X
X   IF DEBUG_state
X      THEN
X        r := GET_INFO(Xbuffer,"RECORD_COUNT");
X        Inform("I","DBGWRFIL",FAO("!UL line!%S written to !AS.",r,f));
X   ENDIF;
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Move_Info(FromBuf, ToBuf)
X
X   POSITION(ToBuf);   MOVE_TEXT(FromBuf);
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Copy_Line(Xstring)
X
X   COPY_TEXT(Xstring); SPLIT_LINE;
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Reuse_Buffer(Xbuffer);
X
X   ERASE(Xbuffer);
X   POSITION(Xbuffer);
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! + TPU CODE COMPRESSION ROUTINES                                      +
X! +                                                                    +
X! +    Pack_TPU(Xstring);                                              +
X! +       This routine takes a line of TPU code as a parameter and     +
X! +       adds it to the current buffer in a way that minimises        +
X! +       as much redundant information as possible to produce as few  +
X! +       lines as possible.  The compressed code will be added to the +
X! +       output file to perform file decoding/unpacking.              +
X! +                                                                    +
X! +--------------------------------------------------------------------+
X
X
XPROCEDURE Pack_TPU(Xstring)
XLOCAL s,c;
X
X  POSITION(END_OF(CURRENT_BUFFER));
X  MOVE_HORIZONTAL(-1);
X
X  s := Xstring;
X  EDIT(s,TRIM);
X  COPY_TEXT(s);
X
X  c := SUBSTR(s,LENGTH(s),1);
X  IF INDEX(TPU_separators,c) = 0
X    THEN
X      COPY_TEXT(" ");
X  ENDIF;
X
X  LOOP
X    EXITIF CURRENT_OFFSET < Max_Line_Length;
X    MOVE_HORIZONTAL(-1);
X    POSITION( SEARCH( ANY(TPU_separators),REVERSE) );
X  ENDLOOP;
X                       `032
X  IF LENGTH(CURRENT_LINE) > Max_Line_Length
X    THEN
X      MOVE_HORIZONTAL(1);`009! Split just past the separator character
X      SPLIT_LINE;
X  ENDIF;
X
X  IF DEBUG_state
X    THEN
X      Inform("I","DBGPCKTPUCUR","Current line is """ + CURRENT_LINE + """");
X      Inform("I","DBGPCKTPUNEW","New string is   """ + s + """");
X      Inform("I","DBGPCKTPULST","Last char is    """ + c + """");
X  ENDIF;
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! + BUFFER ENCODING ROUTINES                                           +
X! +                                                                    +
X! +    Quote_Character;                                                +
X! +        Replaces the current character by an 'escape sequence'      +
X! +        consisting of a flag character followed by exactly 3 digits +
X! +        where the digits are the ASCII code of the character being  +
X! +        replaced.                                                   +
X! +                                                                    +
X! +        The intention is to change characters which may get altered +
X! +        in transit into something that is likely to pass thru       +
X! +        unchanged. Restoration is effected at the receiving end.    +
X! +                                                                    +
X! +    Quote_Buffer(Xbuffer,p);                                        +
X! +        This routine searches a buffer for a particular pattern     +
X! +        (Usually one of a series of specific characters) and        +
X! +        replaces the first character of that pattern by the 'escape'+
X! +        sequence. This is performed at each occurence of that       +
X! +        pattern in the buffer.                                      +
X! +                                                                    +
X! +    Wrap_Lines(Xbuffer, Max_Length);                                +
X! +        This routine wraps lines longer than a fixed size so that   +
X! +        all lines are less/equal to this size.  To allow rejoining  +
X! +        All lines are prefixed with a flag to indicate an initial   +
X! +        line or a continuation line.                                +
X! +                                                                    +
X! +        The intention here is to anticipate the actions of mailers  +
X! +        which have line limits and preempt their wrapping attempts  +
X! +        which would corrupt the data being transmitted. Doing it    +
X! +        this way, we have control over rejoining them.              +
X! +                                                                    +
X! +--------------------------------------------------------------------+
X
X
X
XPROCEDURE Quote_Character
X
X  COPY_TEXT(Quote_Flag+FAO("!3ZL",INDEX(ascii_chars,ERASE_CHARACTER(1))-1));
X
XENDPROCEDURE;
X`012
XPROCEDURE Quote_Buffer(Xbuffer, p)
XLOCAL r;
X
XON_ERROR
X  IF ERROR = TPU$_STRNOTFOUND THEN RETURN; ENDIF;
XENDON_ERROR;
X
X  POSITION( BEGINNING_OF(Xbuffer) );
X
X  LOOP
X    r := SEARCH(p, FORWARD, EXACT);
X    EXITIF r=0;
X    POSITION(r);
X
X    IF DEBUG_state
X      THEN
X        Inform("I","DBGQUOBEFORE", "Current_Line_before="""+CURRENT_LINE+"""
V");
X    ENDIF;
X
X    IF LENGTH(CURRENT_LINE)+3 > TPU_Max_Record_Length
X      THEN
X        Inform("W","TPULONGREC", "Line overlong, Quoting suppressed");
X        Inform("W","CURLINEIS",  """" + CURRENT_LINE + """");
X        MOVE_HORIZONTAL(-CURRENT_OFFSET);
X        MOVE_VERTICAL(1);
X      ELSE
X        Quote_Character;
X    ENDIF;
X
X    IF DEBUG_state
X      THEN
X        Inform("I","DBGQUOAFTER", "Current_Line_after ="""+CURRENT_LINE+""""
V);
X    ENDIF;
X
X  ENDLOOP;
X
XENDPROCEDURE;
X`012
XPROCEDURE Wrap_Lines(Xbuffer, Max_Length)
X
X  POSITION( BEGINNING_OF( Xbuffer ) );
X  LOOP
X    EXITIF MARK(NONE) = END_OF( CURRENT_BUFFER );
X
X    COPY_TEXT( Flag_Initial_Line );
X    LOOP
X      EXITIF LENGTH(CURRENT_LINE) <= Max_Length;
X `032
X      ! Find Last non-blank char on line
X      MOVE_HORIZONTAL(Max_Length-1);`032
X      LOOP
X        MOVE_HORIZONTAL(-1);
X        EXITIF (CURRENT_CHARACTER <> " ") OR (CURRENT_OFFSET < 2);
X      ENDLOOP;
X
X      IF DEBUG_state
X        THEN
X          Inform("I","DBGWRPSPLIT","Splitting Line """+CURRENT_LINE+"""");
X          Inform("I","DBGWRPCHAR", "Split char = """+CURRENT_CHARACTER+"""")
V;
X          Inform("I","DBGWRPOFF",  "Offset = " + STR(CURRENT_OFFSET));
X      ENDIF;
X
X      IF CURRENT_OFFSET < 2
X        THEN
X          MOVE_HORIZONTAL(Max_Length-5);
X          Quote_Character;
X        ELSE
X          MOVE_HORIZONTAL(1);
X      ENDIF;
X
X      ! Split line at last non-blank char or at max line length
X      SPLIT_LINE;
X      COPY_TEXT(Flag_Continuation_Line);
X    ENDLOOP;
X`032
X    ! Move to start of next genuine line
X    MOVE_HORIZONTAL(-1);
X    MOVE_VERTICAL(1);
X
X  ENDLOOP;
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! + Routines to create headers and trailers for insertion in share file+
X! +--------------------------------------------------------------------+
X
X                                                 `032
XPROCEDURE Create_Prologue_Head(Xbuffer, Creator, Blocks, Start_File_List)
XLOCAL filecount,file,nextfile;
X
X  Reuse_Buffer(Xbuffer);
X
X  Copy_Line( "$! ------------------ CUT HERE -----------------------");
X  Copy_Line( "$ v='f$verify(f$trnlnm(""SHARE_VERIFY""))'");
X  Copy_Line( "$!" );
X  Copy_Line( "$! This archive created by " + FAC_name + " Version " + FAC_ve
Vrs);
X  Copy_Line( FAO("$!!   On !%D   By user !AS", 0, Creator) );
X  Copy_Line( "$!" );
X  Copy_Line( "$! This " + FAC_name + " Written by:");
X  Copy_Line( "$!    Andy Harper, Kings College London UK");
X  Copy_Line( "$!" );
X  Copy_Line( "$! Acknowledgements to:");
X  Copy_Line( "$!    James Gray       - Original VMS_SHARE");
X  Copy_Line( "$!    Michael Bednarek - Original Concept and implementation")
V;
X  Copy_Line( "$!");
X  Copy_Line( "$!+ THIS PACKAGE DISTRIBUTED IN 999 PARTS, TO KEEP EACH PART")
V;
X  Copy_Line( "$!  BELOW " + STR(Blocks) + " BLOCKS");
X  Copy_Line( "$!");
X  Copy_Line( "$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER")
V;
+-+-+-+-+-+-+-+-  END  OF PART 3 +-+-+-+-+-+-+-+-

