(* tab p; * * File open/close routines (machine dependent) * *) procedure ParseFile ( VAR FileName : NameType; VAR NamePart : StringType; VAR TypePart : Char4Array; QuoteName : boolean ); var i, j, parlvl : integer; ch : char; NotThru : boolean; begin with FileName do begin i := 1; j := MinString; parlvl := 0; if QuoteName then begin NamePart(.j.) := '"'; j := j + 1; end; ch := String(.i.); while ( i<=valid ) and not ( (ch=':') and (parlvl=0) ) do begin if ch='(' then parlvl := parlvl + 1 else if ch=')' then parlvl := parlvl - 1; NamePart(.j.) := ch; i := i + 1 ; j := j + 1 ; ch := String(.i.); end; if QuoteName then begin NamePart(.j.) := '"'; j := j + 1; end; NamePart(.j.) := ''''; if i>valid then (* no colon - use default type *) TypePart := DefFtype else begin j := 1; NotThru := TRUE; for i := i + 1 to i + MaxFType do begin if (i<=valid) and NotThru then begin ch := String(.i.); if (ch=';') then begin NotThru := FALSE; (* watch out for version delimiter *) ch := ' '; end; TypePart(.j.) := ch end else TypePart(.j.) := ' '; j := j + 1; end; end; end; end; function OpenRead ( VAR ReadFile : ByteFile ; VAR FileName : NameType ) : integer; (* Abstract : Opens ReadFile for Read Does a RESET of the file Returns 0 if Open was successful, i.e. file existed and read access of file was granted. *) var ostat : integer; NamePart : StringType; TypePart : Char4Array; begin ParseFile ( FileName, NamePart, TypePart, OldFile ); Connect ( ReadFile, NamePart, TypePart, 'R', Ostat ); if Ostat=0 then reset( ReadFile ); OpenRead := Ostat; end; function OpenWrite ( VAR WriteFile : ByteFile ; VAR FileName : NameType ) : integer; (* Abstract: Opens WriteFile for Write Does a REWRITE of the file Returns -1 If Open was NOT successful. 0 If Open was immediately successful, i.e. new file or write access granted to existing file, provided FileWarning OFF. 1 If Open was successful after renaming file, i.e. Kermit was able to create the new file *) CONST Existing = 62; var ostat : integer; original : NameType; NamePart : StringType; TypePart : Char4Array; Exit : Boolean; begin (* First: Possible to create new file? *) ParseFile ( FileName, NamePart, TypePart, NewFile ); OpenWrite := 0; (* Assume no trouble at all! *) Connect ( WriteFile, NamePart, TypePart, 'W', Ostat ); if Ostat=0 then begin rewrite( WriteFile ); end else begin (* Not possible, go try something else .. *) if Ostat<>Existing then OpenWrite := -1 (* No hope if other than "File already exists" *) else if FileWarning then begin (* Exit := false; Original := FileName; repeat (* modify file name systematically until able to create new file until Exit; *) OpenWrite := -1; (* Do it simply - so far! *) end else begin (* FileWarning is off - overwriting is permitted *) ParseFile ( FileName, NamePart, TypePart, OldFile ); Connect ( WriteFile, NamePart, TypePart, 'W', Ostat ); if Ostat=0 then begin OpenWrite := 0; rewrite( WriteFile ); end else OpenWrite := -1; end; end; end; function CloseFile( VAR FileToClose : ByteFile ):integer; (* Abstract: Do any actions necessary when closing file *) begin DisConnect ( FileToClose ); CloseFile := 0; end; procedure PutFileName( VAR FileN : NameType; VAR Pack : Packet; Translate : Boolean ); (* Abstract: Puts a file name corresponding to internal format in FileN into a FileHeader packet (Pack). Does any necessary transformations of file name *) VAR NamePart : StringType; TypePart : Char4Array; i, j : integer; ch : char; begin if Translate then begin ParseFile( FileN, NamePart, TypePart, OldFile ); i := MinString; (* skip ( : ) ! *) if NamePart(.i.)='(' then begin while NamePart(.i.) <> ')' do i := i + 1; i := i + 1; end; j := MinString; ch := NamePart(.i.); with Pack do begin while ch<>'''' do begin data(.j.) := ch; i := i + 1; j := j + 1; ch := NamePart(.i.); end; data(.j.) := '.'; for i := 1 to MaxFType do begin j := j + 1; data(.j.) := TypePart(.i.); end; end; end else with Pack do begin j := MinString; for i := MinName to FileN.Valid do begin data(.j.) := FileN.String(.i.); j := j + 1; end; j := j - 1; end; Pack.count := ToChar ( chr ( j + 4 - MinString ) ); Pack.seq := ToChar ( chr ( n ) ); Pack.ptype := PackToCh ( FHeadPack ); end; procedure GetFileName( VAR FileN : NameType; VAR Pack : Packet ); (* Abstract: Gets a file name from a FileHeader packet and converts to internal format in FileN, including any necessary transformations of file name *) VAR i : integer; begin with Pack do begin if ( Ptype<>PackToCh( FHeadPack ) ) and Debug then begin DbgWrite(' Attempts GetFileName from non-FileHeader packet!'); DbgNL; end; FileN.valid := ord ( UnChar ( count ) ) - 3; (* Expecting DEC-10/20, CP/M / MP/M style filenames ., convert to Sintran simply by changing '.' to ':' *) for i := 1 to FileN.valid do begin ch := data(.i - 1 + MinString.); if ch='.' then ch := ':'; FileN.String(.i.) := ch; end; end; end; function BuildList( Parameter : NameType; VAR NameList : NListPtr ): boolean; (* * From given Parameter - construct list of files to send. * Possible forms of parameter: * @filename - Indicating indirect-file - default type :SYMB. * Indirect-file consists of a list of files (one per line) * to send. If the filename is followed by another string * separated from the filename with whitespace, this string * is put into file-header packet instead. This enables you * to specify filename on the remote machine. * filename - Sent without deabbreviation. ("." instead of ":") * filespec - * - 0 or more chars or digits * % - 1 char or digit. * Only filename or type may contain wildcard characters. * Return: success/error. *) var IndFile : text; Status : integer; RetVal : boolean; p : NListPtr; i : integer; procedure ReadString( VAR FromFile : text; VAR StrToRead: NameType ); var ch : char; begin with StrToRead do begin Valid := 0; while ( StripParity( FromFile^ ) <> ' ' ) and not eof( FromFile ) and not eoln( FromFile ) and ( Valid < MaxName ) do begin Valid := Valid + 1; read( FromFile, ch ); String(.Valid.) := StripParity( ch ); end; while not eof(FromFile) and not eoln(FromFile) and ( StripParity( FromFile^ ) <> ' ' ) do read( FromFile, ch ); (* skip until space or eoln *) end; end; procedure EatSpace( VAR FromFile : text ); var ch : char; begin while not eof( FromFile ) and not eoln( FromFile ) and ( StripParity( FromFile^ ) = ' ' ) do read( FromFile, ch ); end; function PosOf( ch : char; Par : NameType ): integer; var i : integer; Found : boolean; begin i := MinString; Found := false; while not Found and ( i < Par.Valid ) do begin i := i + 1; Found := Par.String(.i.) = ch; end; if not Found then i := 0; PosOf := i; end; procedure ReverseList( VAR ThisList : NListPtr ); var p, ToList : NListPtr; begin p := NIL; ToList := NIL; while ThisList <> NIL do begin p := ThisList; ThisList := ThisList^.Next; p^.Next := ToList; ToList := p; end; ThisList := ToList; end; begin NameList := NIL; RetVal := Failure; if Parameter.String(.MinName.) = '@' then begin with Parameter do begin for i := MinName to Valid - 1 do String(.i.) := String(.i+1.); Valid := Valid - 1; String(.Valid+1.) := ''''; connect(IndFile,String,'SYMB','R',Status); if Status <> 0 then writeln('Could not open indirect-file') else begin reset( IndFile ); while not eof( IndFile ) do begin new(p); EatSpace( IndFile ); while StripParity( IndFile^ ) = '!' do begin readln( IndFile ); EatSpace( IndFile ); end; ReadString( IndFile, p^.Name ); EatSpace( IndFile ); if not eoln( IndFile ) then begin ReadString( IndFile,p^.AltName ); p^.AltUsed := true; end else p^.AltUsed := false; readln( IndFile ); p^.Next := NameList; NameList := p; end; disconnect( IndFile ); ReverseList( NameList ); RetVal := Success; end; end; end else if ( PosOf('%',Parameter) > 0) or ( PosOf('*',Parameter) > 0 ) then begin writeln('Wildcards not yet implemented'); end else begin new( NameList ); NameList^.Name := Parameter; NameList^.AltUsed := False; NameList^.Next := NIL; RetVal := Success; end; BuildList := RetVal; end; procedure ShowList( FileList : NListPtr ); var p : NListPtr; procedure PrName( VAR f : text; Name : NameType ); var i : integer; begin for i := 1 to Name.Valid do write( f, Name.String(.i.) ); end; begin p := FileList; while p <> NIL do begin PrName( output, p^.Name ); if p^.AltUsed then begin write( output, ' - ' ); PrName( output, p^.AltName ); end; writeln( output ); p := p^.Next; end; end;