DIRECTORY
Basics USING [ UnsafeBlock ],
BasicTime USING [ GMT, Now, nullGMT ],
Convert USING [ CardFromRope ],
DFUtilities USING [ CommentItem, Date, DirectoryItem, FileItem, WhiteSpaceItem, WriteItemToStream ],
IO USING [ card, GetIndex, PutF, PutFR, rope, SetIndex, STREAM, time, UnsafeGetBlock ],
RefText USING [ ObtainScratch, ReleaseScratch ],
Rope USING [ Fetch, FromRefText, Length, ROPE ],
Tar USING [ EnumProc, FileInfo, InfoProc, SinkProc ],
TarFileFormat USING [ Header, headerBytes, Link, LinkType, NAME, NAMSIZ, OCTAL8, OCTAL12, TBLOCK ],
TarPrivate,
UXTime USING [ ToGMT, UP, UXTIME ];

TarImpl: CEDAR MONITOR
IMPORTS BasicTime, Convert, DFUtilities, IO, RefText, Rope, UXTime
EXPORTS Tar, TarPrivate ~ {
OPEN Tar, TarFileFormat;

ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;

Malformed: PUBLIC ERROR [ how: ROPE ] ~ CODE;
Warning: PUBLIC SIGNAL [ msg: ROPE ] ~ CODE;

Finished: PUBLIC ERROR ~ CODE;

FileInfoFromHeader: PUBLIC PROC [ h: Header ] RETURNS [ info: FileInfo ] ~ {
chksum: CARD32 ~ Checksum[h];
otherChksum: CARD32 ~ OtherChecksum[h];
info.name _ RopeFromName[h.name];
info.mode _ CardFromOctal8[h.mode];
info.uid _ CardFromOctal8[h.uid];
info.gid _ CardFromOctal8[h.gid];
info.size _ CardFromOctal12[h.size];
info.mtime _ CardFromOctal12[h.mtime];
info.chksum _ CardFromOctal8[h.chksum];
[info.linkflag, info.linkname] _ DecodeLinkName[h.link];
IF ( chksum # info.chksum ) THEN Warning["bad Header/Checksum"];
IF ( otherChksum # info.chksum ) THEN Warning["bad Header/OtherChecksum"];
};

HeaderFromFileInfo: PUBLIC PROC[ info: FileInfo ] RETURNS[ h: Header ] ~ {
h.name _ NameFromRope[info.name];
h.mode _ Octal8FromCard[info.mode];
h.uid _ Octal8FromCard[info.uid];
h.gid _ Octal8FromCard[info.gid];
h.size _ Octal12FromCard[info.size];
h.mtime _ Octal12FromCard[info.mtime];
h.link _ LinkFromRope[info.linkname];
h.chksum _ Octal8FromCard[Checksum[h]];
};

Checksum: PUBLIC PROC [ h: Header ] RETURNS [ chksum: CARD32 _ 0 ] ~ TRUSTED {
p: LONG POINTER TO PACKED ARRAY [0..headerBytes) OF BYTE ~ LOOPHOLE[LONG[@h]];
FOR i: NAT IN [0..headerBytes) DO chksum _ chksum + p[i]; ENDLOOP;
FOR i: NAT IN [0..8) DO chksum _ chksum - h.chksum[i].ORD; ENDLOOP;
FOR i: NAT IN [0..8) DO chksum _ chksum + 40B; ENDLOOP;
};

OtherChecksum: PUBLIC PROC [ h: Header ] RETURNS [ chksum: CARD32 _ 0 ] ~ TRUSTED {
p: LONG POINTER TO PACKED ARRAY [0..headerBytes) OF BYTE ~ LOOPHOLE[LONG[@h]];
FOR i: NAT IN [0..headerBytes) DO chksum _ chksum + p[i]; ENDLOOP;
FOR i: NAT IN [0..8) DO chksum _ chksum + 40B; ENDLOOP;
FOR i: NAT IN [0..8) DO chksum _ chksum - h.chksum[i].ORD; ENDLOOP;
};

EmptyHeader: PUBLIC PROC [ h: Header ] RETURNS [ yes: BOOL _ FALSE ] ~ TRUSTED {
p: LONG POINTER TO PACKED ARRAY [0..headerBytes) OF BYTE ~ LOOPHOLE[LONG[@h]];
FOR i: NAT IN [0..headerBytes) DO IF ( p[i] # 0 ) THEN RETURN; ENDLOOP;
yes _ TRUE;
};

CardFromOctal8: PUBLIC PROC [ o: OCTAL8 ] RETURNS [ c: CARD32 ] ~ {
text: REF TEXT ~ RefText.ObtainScratch[6];
SELECT TRUE FROM
( o[7] # '\000 ) => { Warning["missing NUL in OCTAL8"] };
( o[6] # '  ) => { Warning["missing SPACE in OCTAL8"] };
ENDCASE => { NULL };
FOR i: NAT IN [0..6) DO text[i] _ o[i]; text.length _ i.SUCC; ENDLOOP;
{
rope: ROPE ~ Rope.FromRefText[text];
c _ Convert.CardFromRope[rope, 8];
RefText.ReleaseScratch[text];
};
};

Octal8FromCard: PUBLIC PROC [ c: CARD32 ] RETURNS[ o8: OCTAL8 ] = {
r: ROPE ~ IO.PutFR["%6b", [cardinal[c]] ];
o8[7] _ '\000;
o8[6] _ ' ;
FOR i: NAT IN [0..6) DO
o8[i] _ r.Fetch[i];
ENDLOOP;
};

CardFromOctal12: PUBLIC PROC [ o: OCTAL12 ] RETURNS [ c: CARD32 ] ~ {
text: REF TEXT ~ RefText.ObtainScratch[11];
SELECT TRUE FROM
( o[11] # '  ) => { Warning["missing SPACE in OCTAL12"] };
ENDCASE => { NULL };
FOR i: NAT IN [0..11) DO text[i] _ o[i]; text.length _ i.SUCC; ENDLOOP;
{
rope: ROPE ~ Rope.FromRefText[text];
c _ Convert.CardFromRope[rope, 8];
RefText.ReleaseScratch[text];
};
};

Octal12FromCard: PUBLIC PROC [ c: CARD32 ] RETURNS [ o12: OCTAL12 ] ~ {
r: ROPE ~ IO.PutFR["%11b", [cardinal[c]] ];
o12[11] _ ' ;
FOR i: NAT IN [0..11) DO
o12[i] _ r.Fetch[i];
ENDLOOP;
};

GMTFromOctal12: PUBLIC PROC [ o: OCTAL12 ] RETURNS [ time: BasicTime.GMT ] ~ {
card32: CARD32 ~ CardFromOctal12[o];
uxtime: UXTime.UXTIME ~ UXTime.UP[card32];
time _ uxtime.ToGMT[];
};

RopeFromName: PUBLIC PROC [ name: NAME ] RETURNS [ r: ROPE ] ~ {
text: REF TEXT ~ RefText.ObtainScratch[NAMSIZ];
FOR i: NAT IN [0..NAMSIZ) WHILE ( name[i] # '\000 )
DO text[i] _ name[i]; text.length _ i.SUCC; ENDLOOP; 
r _ Rope.FromRefText[text];
RefText.ReleaseScratch[text];
};

NameFromRope: PUBLIC PROC [ r: ROPE ] RETURNS[ n: NAME ] ~ {
FOR i: INT IN [0..r.Length[]) DO n[i] _ r.Fetch[i]; ENDLOOP;
FOR i: INT IN [r.Length[] .. NAMSIZ) DO n[i] _ '\000; ENDLOOP;
};

LinkFromRope: PUBLIC PROC [ r: ROPE ] RETURNS[ l: Link ] ~ {
FOR i: INT IN [0..r.Length[]) DO l[i] _ r.Fetch[i]; ENDLOOP;
FOR i: INT IN [r.Length[] .. NAMSIZ+2) DO l[i] _ '\000; ENDLOOP;
};

DecodeLinkName: PUBLIC PROC [ link: Link ] RETURNS [ flag: LinkType, name: ROPE ] ~ {
text: REF TEXT ~ RefText.ObtainScratch[NAMSIZ];
flag _ VAL[link.bytes[0].ORD];
FOR i: NAT IN [0..NAMSIZ) WHILE ( link.bytes[i.SUCC] # '\000 )
DO text[i] _ link.bytes[i.SUCC]; text.length _ i.SUCC; ENDLOOP; 
name _ Rope.FromRefText[text];
RefText.ReleaseScratch[text];
};

GetHeader: PUBLIC PROC [ s: IO.STREAM ] RETURNS [ h: Header ] ~ TRUSTED {
finger: INT ~ s.GetIndex[];
unsafe: Basics.UnsafeBlock ~ [LOOPHOLE[LONG[@h]], 0, headerBytes];
IF ( s.UnsafeGetBlock[unsafe] # headerBytes )
THEN ERROR Malformed["EOF encountered when reading header"];
IF ( EmptyHeader[h] ) THEN ERROR Finished[];
s.SetIndex[finger+TBLOCK];
};

Scan: PUBLIC PROC [ s: IO.STREAM, p: InfoProc ]
RETURNS [ aborted: BOOL _ FALSE ] ~ TRUSTED {
DO
header: Header ~ GetHeader[s ! Finished => GOTO Bottom];
info: FileInfo ~ FileInfoFromHeader[header];
finger: INT ~ s.GetIndex[];
records: INT ~ ( info.size + TBLOCK.PRED ) / TBLOCK;
bytes: INT ~ records * TBLOCK;
newIndex: INT ~ finger+bytes;
IF ( aborted _ p[info, s] ) THEN RETURN;
SELECT info.linkflag FROM
zero => { s.SetIndex[newIndex] };
normal => { s.SetIndex[newIndex] };
hard => { NULL };
symbolic => { NULL };
ENDCASE => { ERROR };
ENDLOOP;
EXITS
Bottom => { NULL };
};
blankLine: REF DFUtilities.WhiteSpaceItem ~ NEW[DFUtilities.WhiteSpaceItem _ [lines: 1]];
noDate: DFUtilities.Date ~ [format: $omitted, gmt: BasicTime.nullGMT];

FromDF: PUBLIC PROC [s: STREAM, enum: EnumProc, sink: SinkProc, dfFile: STREAM] ~ {
ERROR;
};

AddInfoHdr: PROC [s: STREAM, project: ROPE, user: ROPE]~ {
projectLine: ROPE ~ IO.PutFR["-- %g.df", [rope[project]]];
copyright: ROPE ~ "-- Copyright Σ 1989, by Xerox Corporation.  All rights reserved.";
timeLine: ROPE ~ IO.PutFR["-- %g, %g", IO.rope[user], IO.time[BasicTime.Now[]]];
comment: REF DFUtilities.CommentItem ~ NEW[DFUtilities.CommentItem];
comment.text _ projectLine; DFUtilities.WriteItemToStream[s, comment];
comment.text _ copyright; DFUtilities.WriteItemToStream[s, comment];
comment.text _ timeLine; DFUtilities.WriteItemToStream[s, comment];
DFUtilities.WriteItemToStream[s, blankLine];
};

AddBoilerplate: PROC [s: IO.STREAM, pseudo: ROPE, project: ROPE]~ {
topName: ROPE ~ IO.PutFR["[%g]<Top>", IO.rope[pseudo] ];
dirName: ROPE ~ IO.PutFR["[%g]<%g>", IO.rope[pseudo], IO.rope[project] ];
dfName: ROPE ~ IO.PutFR["%g.df", IO.rope[project] ];
export: REF DFUtilities.DirectoryItem ~ NEW[DFUtilities.DirectoryItem _ [path1: NIL, path2: NIL, path2IsCameFrom: FALSE, exported: TRUE, readOnly: FALSE]];
dir: REF DFUtilities.DirectoryItem ~ NEW[DFUtilities.DirectoryItem _ [path1: NIL, path2: NIL, path2IsCameFrom: FALSE, exported: FALSE, readOnly: FALSE]];
file: REF DFUtilities.FileItem ~ NEW[DFUtilities.FileItem _ [name: NIL, date: noDate, verifyRoot: FALSE]];
export.path1 _ topName; DFUtilities.WriteItemToStream[s, export];
DFUtilities.WriteItemToStream[s, blankLine];
file.name _ dfName; DFUtilities.WriteItemToStream[s, file];
DFUtilities.WriteItemToStream[s, blankLine];
dir.path1 _ dirName; DFUtilities.WriteItemToStream[s, dir];
DFUtilities.WriteItemToStream[s, blankLine];
};

EntryForInfo: PROC [ info: FileInfo ]
RETURNS [ name: ROPE, date: DFUtilities.Date ] ~ {
uxtime: UXTime.UXTIME ~ UXTime.UP[info.mtime];
gmt: BasicTime.GMT ~ uxtime.ToGMT[];
name _ info.name;
date _ [format: $explicit, gmt: gmt];
};

AddTarFile: PROC [dfFile: IO.STREAM, tarfile: IO.STREAM] ~ {
AddTarEntry: InfoProc ~ {
file: REF DFUtilities.FileItem ~ NEW[DFUtilities.FileItem _
[name: NIL, date: noDate, verifyRoot: FALSE]];
[file.name, file.date] _ EntryForInfo[info];
DFUtilities.WriteItemToStream[dfFile, file];
};
[] _ Scan[tarfile, AddTarEntry];
};

AddBottom: PROC [s: IO.STREAM] ~ {
eof: ROPE ~ "-- eof";
comment: REF DFUtilities.CommentItem ~ NEW[DFUtilities.CommentItem];
DFUtilities.WriteItemToStream[s, blankLine];
comment.text _ eof; DFUtilities.WriteItemToStream[s, comment];
};

ToDF: PUBLIC PROC [s: IO.STREAM, pseudo: ROPE, project: ROPE, dfFile: IO.STREAM] ~ {
user: ROPE ~ "Created via Tar.ToDF";
AddInfoHdr[dfFile, project, user];
AddBoilerplate[dfFile, pseudo, project];
AddTarFile[dfFile, s];
AddBottom[dfFile];
};
stdout: IO.STREAM;
PrintInfo: InfoProc ~ {
stdout.PutF[" name: %g", IO.rope[info.name] ];
stdout.PutF[" mode: %g", IO.card[info.mode] ];
stdout.PutF[" uid: %g", IO.card[info.uid] ];
stdout.PutF[" gid: %g", IO.card[info.gid] ];
stdout.PutF[" size: %g", IO.card[info.size] ];
stdout.PutF[" mtime: %g", IO.card[info.mtime] ];
stdout.PutF[" chksum: %g", IO.card[info.chksum] ];
stdout.PutF[" linkflag: %g", IO.card[info.linkflag.ORD] ];
stdout.PutF[" linkname: %g\n", IO.rope[info.linkname] ];
};

}.

v
TarImpl.mesa
Copyright Σ 1989 by Xerox Corporation.  All rights reserved.
Bill Jackson (bj) July 7, 1989 10:12:14 pm PDT
Willie-sue, August 10, 1989 1:02:39 pm PDT

o8[i] _ IF r.Fetch[i] = '   THEN '\000 ELSE r.Fetch[i];
( o[12] # '\000 ) => { Warning["missing NUL in OCTAL12"] };
o12[i] _ IF r.Fetch[i] = '   THEN '\000 ELSE r.Fetch[i];
DF processing
for debugging

Κ
7™
codeš
œ™K™<Kš
œ.™.K™*K™—š
Οk	˜	Kšœœ˜Kšœ
œœ˜&Kšœœ˜KšœœS˜dKšœ
œ0œ˜WKšœœ#˜0Kšœœœ˜0Kšœœ,˜5Kš
œœ(œœœœœ˜cKš
œ˜Kšœœ
œœ˜#K˜—šΟnœœ
˜Kšœ"œ˜BKšœ˜Kšœ˜K˜Kšœœœ
˜Kšœœœ
œ
˜K˜Kš
ž	œœ
œœœ
˜-Kš
žœœ
œœœ
˜,K˜Kšžœœœ
˜K˜šžœœ
œœ˜LKšœœ˜Kšœ
œ˜'Kš
œ!˜!Kš
œ#˜#Kš
œ!˜!Kš
œ!˜!Kš
œ$˜$Kš
œ&˜&Kš
œ'˜'Kš
œ8˜8Kšœœ ˜@Kšœœ%˜JKš
œ˜K˜—šžœœ
œœ˜JKš
œ!˜!Kš
œ#˜#Kš
œ!˜!Kš
œ!˜!Kš
œ$˜$Kš
œ&˜&Kš
œ%˜%Kš
œ'˜'K˜K˜—šžœœ
œœœ	œ˜NKšœœ
œ
œ
œ
œœ
œœ
œ˜NKš
œœ
œœœ
˜BKšœœ
œœœœ
˜CKš
œœ
œœœ
˜7Kš
œ˜K˜—šž
œœ
œœœ	œ˜SKšœœ
œ
œ
œ
œœ
œœ
œ˜NKš
œœ
œœœ
˜BKš
œœ
œœœ
˜7Kšœœ
œœœœ
˜CKš
œ˜K˜—šžœœ
œœœœœ˜PKšœœ
œ
œ
œ
œœ
œœ
œ˜NKšœœ
œœ
œœ
œœ
˜GKšœœ
˜Kš
œ˜K˜—šžœœ
œœœœ˜CKšœœ
œ˜*šœ
œ
˜Kš
œ9˜9Kš
œ8˜8Kšœœ˜—Kšœœ
œœ!œœ
˜Fš
œ
˜
Kšœœ˜$Kš
œ"˜"Kš
œ˜Kš
œ˜—Kš
œ˜K˜—šžœœ
œœœœ˜CKšœœœ˜*Kš
œ˜K˜šœœ
œ˜Kšœœœœ™7Kš
œ˜Kšœ
˜—K˜K˜—šžœœ
œœœœ˜EKšœœ
œ˜+šœ
œ
˜Kš
œ;™;Kš
œ:˜:Kšœœ˜—Kšœœ
œ	œ!œœ
˜Gš
œ
˜
Kšœœ˜$Kš
œ"˜"Kš
œ˜Kš
œ˜—K˜K˜—šžœœ
œœœœ˜GKšœœœ˜+K˜
šœœ
œ	˜Kšœ	œœœ™8Kš
œ˜Kšœ
˜—K˜K˜—šžœœ
œœœœ˜NKšœœ˜$Kšœœ
œ	˜*Kš
œ˜Kš
œ˜K˜—šžœœ
œ	œœœ˜@Kšœœ
œœ˜/Kšœœ
œœœœ$œœ˜iKš
œ˜Kš
œ˜K˜K˜—šžœœ
œœœœ˜<Kš
œœ
œœœ
˜<Kšœœ
œœœœ
˜>K˜K˜—š
žœœ
œœœ˜<Kš
œœ
œœœ
˜<Kšœœ
œœœœ
˜@K˜K˜—š
žœœ
œœœ˜UKšœœ
œœ˜/Kšœœœ˜Kšœœ
œœœœœœœœ˜Kš
œ˜Kš
œ˜K˜K˜—šž	œœ
œœ
œœœ˜IKšœœ˜Kšœœ
œ˜BKšœ,œ
œ2˜jKšœœ
œ˜,Kšœœ˜Kš
œ˜K˜—šžœœ
œœ
œœœœœ˜]š
˜Kšœ+œ	˜8Kš
œ,˜,Kšœœ˜Kš	œ	œœ
œœ
˜4Kšœœ
œ
˜Kšœ
œ˜Kšœœ
œ
˜(šœ˜Kš
œ!˜!Kš
œ#˜#Kšœ
œ˜Kšœœ˜Kšœœ˜—Kšœ
˜—š
˜Kšœœ˜—Kš
œ˜—
headšΠkzΟz™
Kšœœœ*˜YKš
œF˜FK˜š
žœœ
œœ*œ˜SKšœ
˜Kš
œ˜K˜—š
ž
œœœœœ˜:Kšœ
œœ$˜:KšœœF˜UKš	œ
œœœ
œ˜PKšœ	œœ˜DKš
œF˜FKš
œD˜DKš
œC˜CKš
œ,˜,Kš
œ˜K˜—šžœœœ
œ
œœ˜CKšœ	œœœ˜8Kš	œ	œœœœ˜IKšœœœœ˜4Kšœœœ%œ	œœœœ˜›
Kšœœœ%œ	œœœœ˜™
Kš	œœœœœ˜jKš
œA˜AKš
œ,˜,Kš
œ;˜;Kš
œ,˜,Kš
œ;˜;Kš
œ,˜,Kš
œ˜K˜—šžœœœ	œ˜XKšœœ
œ
˜.Kšœœ˜$Kš
œ˜Kš
œ%˜%K˜K˜—šž
œœ
œ
œœ
œ˜<šžœ˜Kš	œœœœœ˜jKš
œ,˜,Kš
œ,˜,K˜—Kš
œ ˜ Kš
œ˜K˜—šž	œœœ
œ˜"Kšœœ˜Kšœ	œœ˜DKš
œ,˜,Kš
œ>˜>Kš
œ˜K˜—šžœœ
œœ
œ
œœ
œ
œ˜TKšœœ˜$Kš
œ"˜"Kš
œ(˜(Kš
œ˜Kš
œ˜K˜——š
 
™
Kšœœ
œ
˜šž	œ˜Kšœœ˜.Kšœœ˜.Kšœœ˜,Kšœœ˜,Kšœœ˜.Kšœœ˜0Kšœœ˜2Kšœœœ˜:Kšœœ˜8K˜K˜——K˜—K™—…—%ˆ45