From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 23-MAY-1989 11:41
To:	MRGATE::"ARISIA::EVERHART"
Subj:	undelete program part 2 of 3

Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Tue, 23 MAY 89 07:08:07 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Tue, 23 May 89 07:06:28 PDT
Received: by ucbvax.Berkeley.EDU (5.61/1.36)
	id AA17099; Tue, 23 May 89 06:54:50 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 23 May 89 09:33:25 GMT
From: mcvax!ukc!stl!scott@uunet.uu.net  (Mike Scott)
Organization: STC Technology Limited, London Road, Harlow, Essex, UK
Subject: undelete program part 2 of 3
Message-Id: <1470@stl.stc.co.uk>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

+-+-+-+ Beginning of part 2 +-+-+-+
X
X`009FAB`009`009: `094FAB$TYPE;
X`009NAM`009`009: `094NAM$TYPE;
X
X`009ES, RS, DN`009: $STRING;
X`009Status`009`009: INTEGER;
X
X`009FIB`009`009: `094FIB$TYPE;
X`009FAT`009`009: FAT$TYPE;
X
X`009FIB$IOSB`009: $IOSB;
X`009FIB$DESCR`009: $DESCR;
X
X`009Channel`009`009: $UWORD;
X`009Device`009`009: $STRING;
X
X`009Home`009`009: HM$TYPE;
X
X`009IB_Index`009: INTEGER;
X`009Bitmap`009`009: PACKED ARRAY [1..MAX_FILES] OF BOOLEAN;
X
X`009Header_List`009: `094VMFH$TYPE;
X
X`009Proc_Priv`009: PACKED ARRAY [0..MAX_PRIVS] OF BOOLEAN;
X
X`009Pname, Ptype,`032
X`009Pver`009`009: $STRING;
X
V`123`012---------------------------------------------------------------------
X-----`125
X
XFUNCTION Decode_Map (Map : MAP$PTR; VAR Count, LBN : INTEGER) : INTEGER;
X
XCONST`009PLACEMENT`009= 0;
X`009FORMAT1`009`009= 1;
X`009FORMAT2`009`009= 2;
X`009FORMAT3`009`009= 3;
X
XBEGIN
X
X    CASE Map`094.MAP$TYPE OF
X`009PLACEMENT`009: BEGIN
X`009`009`009`009Count := 0;
X`009`009`009`009LBN := 0;
X`009`009`009`009Decode_Map := 2;
X`009`009`009  END;
X`009FORMAT1`009`009: BEGIN
X`009`009`009`009Count := Map`094.FIELD$1 + 1;`032
X`009`009`009`009LBN := (Map`094.FIELD$2 * 2**16) + Map`094.FIELD$3;
X`009`009`009`009Decode_Map := 4;
X`009`009`009  END;
X`009FORMAT2`009`009: BEGIN
X`009`009`009`009Count := (Map`094.FIELD$2 * 2**8) +`032
X`009`009`009`009`009 Map`094.FIELD$1 + 1;
X`009`009`009`009LBN := (Map`094.FIELD$4 * 2**16) + Map`094.FIELD$3;
X`009`009`009`009Decode_Map := 6;
X`009`009`009  END;
X`009FORMAT3`009`009: BEGIN
X`009`009`009`009Count := (Map`094.FIELD$3 * 2**16) +
X`009`009`009`009`009 (Map`094.FIELD$2 * 2**8) +`032
X`009`009`009`009`009 Map`094.FIELD$1 + 1;
X`009`009`009`009LBN := (Map`094.FIELD$5 * 2**16) + Map`094.FIELD$4;
X`009`009`009`009Decode_Map := 8;
X`009`009`009  END;
X    END;
X
XEND;
X
V`123`012---------------------------------------------------------------------
X-----`125
X
XFUNCTION Check_Header (Bitmap_Index : INTEGER) : INTEGER;
X
XVAR`009Status`009`009`009: INTEGER;
X`009Header`009`009`009: FH$TYPE;
X`009H$IOSB`009`009`009: $IOSB;
X`009Chain, Extension, Tail`009: `094VMFH$TYPE;
X`009Next_FIDNUM,`032
X`009Expected_SEGNUM `009: $UWORD;
X
XBEGIN
X    Status := $QIOW(`009CHAN`009:= Channel,
X`009`009`009FUNC`009:= IO$_READVBLK,
X`009`009`009IOSB`009:= H$IOSB,
X`009`009`009P1`009:= Header,
X`009`009`009P2`009:= SIZE(Header),
X`009`009`009P3`009:= Bitmap_Index - 1 +
X`009`009`009`009   Home.HM$IBMAPVBN +
X`009`009`009`009   Home.HM$IBMAPSIZE);
X    IF  ODD(Status)`032
X    AND ODD(H$IOSB.Status)`032
X    AND (Header.FH$SEG_NUM = 0)
X    AND (Header.FH$BK_FIDNUM = NAM`094.NAM$W_DID_NUM)
X    THEN BEGIN
X`009NEW(Chain);
X
X`009Chain`094.Header   := Header;
X`009Chain`094.Exheader := NIL;
X`009Chain`094.Data     := NIL;
X`009Chain`094.Link     := Header_List;
X`009Header_List     := Chain;
X
X`009Expected_SEGNUM := 0;
X
X`009Tail := Chain;
X
X`009WHILE Header.FH$EX_FIDNUM <> 0 DO
X`009BEGIN
X`009    Next_FIDNUM := Header.FH$EX_FIDNUM;
X`009    Expected_SEGNUM := Expected_SEGNUM + 1;
X
X`009    Status := $QIOW(`009CHAN`009:= Channel,
X`009`009`009`009FUNC`009:= IO$_READVBLK,
X`009`009`009`009IOSB`009:= H$IOSB,
X`009`009`009`009P1`009:= Header,
X`009`009`009`009P2`009:= SIZE(Header),
X`009`009`009`009P3`009:= Next_FIDNUM - 1 +
X`009`009`009`009`009   Home.HM$IBMAPVBN +
X`009`009`009`009`009   Home.HM$IBMAPSIZE);
X`009    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X`009    IF NOT ODD(H$IOSB.Status) THEN LIB$SIGNAL(H$IOSB.Status);
X
X`009    IF Header.FH$SEG_NUM = Expected_SEGNUM
X`009    THEN BEGIN
X`009`009NEW(Extension);
X`009`009Extension`094.Header   := Header;
X`009`009Extension`094.Exheader := NIL;
X`009`009Extension`094.Data     := NIL;
X`009`009Extension`094.Link     := NIL;
X`009`009Tail`094.Exheader      := Extension;
X`009`009Tail                := Extension;
X`009    END
X`009    ELSE Header.FH$EX_FIDNUM := 0;
X`009END;
X    END;
X
X
X    IF NOT ODD(Status) THEN Check_Header := Status
X    ELSE Check_Header := H$IOSB.Status;
XEND;
X
V`123`012---------------------------------------------------------------------
X-----`125
X
XPROCEDURE Pre_Parse (VAR Wild : $STRING);
X
XVAR`009WAoff, WPoff, Woff`009: INTEGER;
X
XBEGIN
X    Woff := INDEX(Wild, '*%');
X    WHILE Woff <> 0 DO
X    BEGIN
X`009Wild[Woff] := '%';
X`009Wild[Woff + 1] := '*';
X`009Woff := INDEX(Wild, '*%')
X    END;
X
X    Woff := INDEX(Wild, '**');
X    WHILE Woff <> 0 DO
X    BEGIN
X`009Wild := SUBSTR(Wild, 1, Woff) + SUBSTR(Wild, Woff + 2,`032
X`009`009`009`009`009`009`009Wild.Length - Woff - 1);
X`009Woff := INDEX(Wild, '**')
X    END;
XEND;
X
V`123`012---------------------------------------------------------------------
X-----`125
X
XPROCEDURE Prep;
X
XTYPE`009PSTRING`009= PACKED ARRAY [1..MAX_NAME] OF CHAR;
X
XVAR`009Name`009: `094PSTRING;
X
XBEGIN
X    Name::UNSIGNED := NAM`094.NAM$L_NAME;
X    Pname := Name`094;
X    Pname.Length := NAM`094.NAM$B_NAME;
X    Pre_Parse(Pname);
X
X    Name::UNSIGNED := NAM`094.NAM$L_TYPE + 1;
X    Ptype := Name`094;
X    Ptype.Length := NAM`094.NAM$B_TYPE - 1;
X    Pre_Parse(Ptype);
X
X    Name::UNSIGNED := NAM`094.NAM$L_VER + 1;
X    Pver := Name`094;
X    Pver.Length := NAM`094.NAM$B_VER - 1;
XEND;
X
V`123`012---------------------------------------------------------------------
X-----`125
X
XFUNCTION Compare(Wild, Exp : $STRING) : BOOLEAN;
X
XVAR`009WAoff, WPoff, Woff`009: INTEGER;
X`009Match`009`009`009: BOOLEAN;
X`009Sub_Wild, Sub_Exp`009: $STRING;
X`009Syncoff`009`009`009: INTEGER;
X`009Sync`009`009`009: $STRING;
X
XBEGIN
X    WPoff := INDEX(Wild, '%');
X    WAoff := INDEX(Wild, '*');
X    IF ((WPoff < WAoff) AND (WPoff <> 0)) OR (WAoff = 0)
X    THEN Woff := WPoff
X    ELSE Woff := WAoff;
X
X    IF Woff = 0
X    THEN BEGIN
X`009IF Wild.Length = Exp.Length
X`009THEN BEGIN
X`009    IF Wild = Exp
X`009    THEN Match := TRUE
X`009    ELSE Match := FALSE
X`009END
X`009ELSE Match := FALSE
X    END
X    ELSE BEGIN
X`009IF Exp.Length < Woff
X`009THEN Match := FALSE
X`009ELSE BEGIN
X`009    Sub_Wild := SUBSTR(Wild, 1, Woff - 1);
X`009    Sub_Exp := SUBSTR(Exp, 1, Woff - 1);
X`009    IF Sub_Wild = Sub_Exp
X`009    THEN Match := TRUE
X`009    ELSE Match := FALSE
X`009END;
X    END;
X
X    IF (Match = TRUE) AND (Woff = 0)
X    THEN Compare := TRUE
X    ELSE IF Match = FALSE
X    THEN Compare := FALSE
X    ELSE BEGIN
X`009IF Wild[Woff] = '%'
X`009THEN BEGIN
X`009    Sub_Wild := SUBSTR(Wild, Woff + 1, Wild.Length - Woff);
X`009    Sub_Exp := SUBSTR(Exp, Woff + 1, Exp.Length - Woff);
X`009    Compare := Compare(Sub_Wild, Sub_Exp);
X`009END
X`009ELSE BEGIN
X`009    Sub_Wild := SUBSTR(Wild, Woff + 1, Wild.Length - Woff);
X`009    Sub_Exp := SUBSTR(Exp, Woff, Exp.Length - Woff + 1);
X
X`009    WPoff := INDEX(Sub_Wild, '%');
X`009    WAoff := INDEX(Sub_Wild, '*');
X`009    IF ((WPoff < WAoff) AND (WPoff <> 0)) OR (WAoff = 0)
X`009    THEN Woff := WPoff
X`009    ELSE Woff := WAoff;
X`009    IF Woff = 0
X`009    THEN Woff := Sub_Wild.Length;
X
X`009    IF Woff = 0
X`009    THEN Compare := TRUE
X`009    ELSE BEGIN
X`009`009Sync := SUBSTR(Sub_Wild, 1, Woff - 1);
X`009`009Syncoff := INDEX(Sub_Exp, Sync);
X`009`009IF Syncoff = 0
X`009`009THEN Compare := FALSE
X`009`009ELSE BEGIN
X`009`009    Sub_Exp := SUBSTR(Sub_Exp, Syncoff,
X`009`009`009`009`009`009Sub_Exp.Length - Syncoff + 1);
X`009`009    Compare := Compare(Sub_Wild, Sub_Exp);
X`009`009END;
X`009    END;
X`009END
X    END;
XEND;
X
V`123`012---------------------------------------------------------------------
X-----`125
X
XFUNCTION Selected (Full_Name : $STRING) : BOOLEAN;
X
XVAR`009Fname, Ftype, Fver`009: $STRING;
X`009Dot, Semicolon`009`009: INTEGER;
X`009Match`009`009`009: BOOLEAN;
X
XBEGIN
X    Dot := INDEX(Full_Name, '.');
X    Fname := SUBSTR(Full_Name, 1, Dot - 1);
X
X    Semicolon := INDEX(Full_Name, ';');
X    Ftype := SUBSTR(Full_Name, Dot + 1, Semicolon - Dot - 1);
X
X    Fver := SUBSTR(Full_Name, Semicolon + 1, Full_Name.Length - Semicolon);
X
X    Match := Compare(Pname, Fname);
X
X    IF Match = TRUE
X    THEN Match := Compare(Ptype, Ftype);
X
X    IF Match = TRUE
X    THEN Match := Compare(Pver, Fver);
X
X    Selected := Match;
XEND;
X
V`123`012---------------------------------------------------------------------
X-----`125
X
XPROCEDURE Read_Files;
X
XVAR`009Status`009`009: INTEGER;
X`009Header`009`009: `094VMFH$TYPE;
X`009Map_Head`009: `094VMFH$TYPE;
X`009Next_Header`009: `094VMFH$TYPE;
X`009Map`009`009: [UNSAFE] `094FM$TYPE;
X`009Ident`009`009: [UNSAFE] `094FI$TYPE;
X`009Name`009`009: $STRING;
X`009Name_Desc`009: $DESCR;
X`009Data`009`009: [UNSAFE] `094FILE$DATA;
X`009Block_Offset`009: INTEGER;
X`009Map_Left, I`009: INTEGER;
X`009Count, LBN`009: INTEGER;
X`009L$IOSB`009`009: $IOSB;
X`009Channel`009`009: $UWORD;
X`009HIBLK`009`009: INTEGER;
X`009Found`009`009: MESSAGE;
X
XBEGIN
X    Status := $ASSIGN(`009DEVNAM`009:= Device,
X`009`009`009CHAN`009:= Channel);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X
X    Prep;
X
X    Header := Header_List;
X    Header_List := NIL;
X
X    WHILE Header <> NIL DO
X    BEGIN
X`009Next_Header := Header`094.Link;
X
V`009Ident := IADDRESS(Header`094.Header) + (Header`094.Header.FH$IDOFFSET * 2
X);
X`009Name := Ident`094.FI$FILENAME + Ident`094.FI$FILENAMEXT;
X`009Name.Length  := INDEX(Name, ' ') - 1;
X
X`009IF Selected(Name)
X`009THEN BEGIN
X`009    Name_Desc.Length`009:= Name.Length;
X`009    Name_Desc.Dtype`009:= 0;
X`009    Name_Desc.Class`009:= 0;
X`009    Name_Desc.Address`009:= IADDRESS(Name.Body);
X
X`009    Found.ARG$COUNT`009`009:= 3;
X`009    Found.DEF$MESSAGE$OPT    `009:= 0;
X`009    Found.MESSAGE$CODE`009`009:= IADDRESS(UNDELETE_LOCATED);
X`009    Found.FAO$COUNT`009`009:= 1;
X`009    Found.NEW$MESSAGE$OPT`009:= 0;
X`009    Found.FAO$1`009`009`009:= IADDRESS(Name_Desc);
X`009    Status := $PUTMSG(`009MSGVEC`009:= Found);
X`009    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X
X`009    HIBLK := (Header`094.Header.FH$RECATTR.FAT$L_HIBLK DIV 65536) +`032
X`009`009    ((Header`094.Header.FH$RECATTR.FAT$L_HIBLK MOD 65536) * 65536);
X
X`009    Status := LIB$GET_VM(HIBLK * 512 + 1, I);
X`009    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X`009    Data := I;
X
X`009    Header`094.Data := Data;
X`009    Header`094.Data_Length := HIBLK * 512;
X
X`009    Map_Head := Header;
X`009    Map_Left := Map_Head`094.Header.FH$MAP_INUSE * 2;
X`009    Map      := IADDRESS(Map_Head`094.Header) +`032
X`009`009`009(Map_Head`094.Header.FH$MPOFFSET * 2);
X
X`009    Block_Offset := 0;
X
X`009    WHILE Map_Left > 0 DO
X`009    BEGIN
X`009`009I := Decode_Map(Map, Count, LBN);
X
X`009`009Status := $QIOW(CHAN`009:= Channel,
X`009`009`009`009FUNC`009:= IO$_READLBLK,
X`009`009`009`009IOSB`009:= L$IOSB,
X`009`009`009`009P1`009:= Data`094[Block_Offset],
X`009 `009`009`009P2`009:= Count * 512,
X`009`009`009`009P3`009:= LBN);
X`009`009IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X`009`009IF NOT ODD(L$IOSB.Status) THEN LIB$SIGNAL(L$IOSB.Status);
X
X`009`009Block_Offset := Block_Offset + Count;
X
X`009`009Map := IADDRESS(Map`094) + I;
X
X`009`009Map_Left := Map_Left - I;
X
X`009`009IF (Map_Left = 0) AND (Map_Head`094.Exheader <> NIL)
X`009`009THEN BEGIN
X`009`009    Map_Head := Map_Head`094.Exheader;
X`009`009    Map_Left := Map_Head`094.Header.FH$MAP_INUSE * 2;
X`009`009    Map      := IADDRESS(Map_Head`094.Header) +`032
X`009`009`009`009(Map_Head`094.Header.FH$MPOFFSET * 2);
X`009`009END;
X`009    END;
X
X`009    Header`094.Link := Header_List;
X`009    Header_List  := Header;
X`009END;
X
X`009Header := Next_Header;
X    END;
X
X    Status := $DASSGN(`009CHAN`009:= Channel);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
XEND;
X
V`123`012---------------------------------------------------------------------
X-----`125
X
XPROCEDURE Write_Files;
X
XTYPE`009Attrib_Entry`009= PACKED RECORD
X`009`009`009`009Attrib_Size`009: $UWORD;
X`009`009`009`009Attrib_Type`009: $UWORD;
X`009`009`009`009Attrib_Addr`009: INTEGER;
X`009`009`009  END;
X
X`009Attrib_List`009= RECORD
X`009`009`009`009RECATTR`009: Attrib_Entry;
X`009`009`009`009UCHAR`009: Attrib_Entry;
X`009`009`009`009UIC`009: Attrib_Entry;
X`009`009`009`009FPRO`009: Attrib_Entry;
X`009`009`009`009CREDATE`009: Attrib_Entry;
X`009`009`009`009BAKDATE`009: Attrib_Entry;
X`009`009`009`009EXPDATE`009: Attrib_Entry;
X`009`009`009`009Tail`009: INTEGER;
X`009`009`009  END;
X
X
X
XVAR`009Status`009`009: INTEGER;
X`009Attributes`009: Attrib_List;
X`009Header`009`009: `094VMFH$TYPE;
X`009Ident`009`009: [UNSAFE] `094FI$TYPE;
X`009Name`009`009: $STRING;
X`009Name_Desc`009: $DESCR;
X`009FIB$IOSB`009: $IOSB;
X`009FIB$DESCR`009: $DESCR;
X`009Channel`009`009: $UWORD;
X`009HIBLK`009`009: INTEGER;
X`009New_Name`009: $STRING;
X`009New_File`009: $STRING;
X`009New_File_Desc`009: $DESCR;
X`009Created`009`009: MESSAGE;
X
XBEGIN
X    Status := $ASSIGN(`009DEVNAM`009:= Device,
X`009`009`009CHAN`009:= Channel);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X
X    NEW(FIB);
X
X    Header := Header_List;
X
X    IF Header = NIL
X    THEN BEGIN
X`009Created.ARG$COUNT`009:= 2;
X`009Created.DEF$MESSAGE$OPT`009:= 0;
X`009Created.MESSAGE$CODE`009:= IADDRESS(UNDELETE_NONFOUND);
X`009Created.FAO$COUNT`009:= 0;
X`009Created.NEW$MESSAGE$OPT`009:= 0;
X`009Status := $PUTMSG(`009MSGVEC`009:= Created);
X`009IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X    END;
X
X    WHILE Header <> NIL DO
X    BEGIN
V`009Ident := IADDRESS(Header`094.Header) + (Header`094.Header.FH$IDOFFSET * 2
X);
X`009Name := Ident`094.FI$FILENAME + Ident`094.FI$FILENAMEXT;
X`009Name.Length := INDEX(Name, ' ') - 1;
X
X`009New_Name := 'UNDELETED_';
X
X`009IF Name.Length + New_Name.Length <= MAX_NAME
X`009THEN New_Name := 'UNDELETED_' + Name
X`009ELSE New_Name := Name;
X
X`009Name_Desc.Length  := New_Name.Length;
X`009Name_Desc.Dtype   := 0;
X`009Name_Desc.Class   := 0;
X`009Name_Desc.Address := IADDRESS(New_Name.Body);
X   `032
X`009New_File_Desc.Length  := SIZE(New_File.Body);
X`009New_File_Desc.Dtype   := 0;
X`009New_File_Desc.Class   := 0;
X`009New_File_Desc.Address := IADDRESS(New_File.Body);
X   `032
X`009HIBLK := (Header`094.Header.FH$RECATTR.FAT$L_HIBLK DIV 65536) +`032
X`009`009((Header`094.Header.FH$RECATTR.FAT$L_HIBLK MOD 65536) * 65536);
X
X`009FIB`094.FIB$W_DID_NUM`009:= Header`094.Header.FH$BK_FIDNUM;
X`009FIB`094.FIB$W_DID_SEQ`009:= Header`094.Header.FH$BK_FIDSEQ;
X`009FIB`094.FIB$W_DID_RVN`009:= Header`094.Header.FH$BK_FIDRVN;
X
X`009FIB`094.FIB$W_EXCTL`009:= FIB$M_EXTEND;
X`009FIB`094.FIB$L_EXSZ`009`009:= HIBLK;
X
X`009FIB`094.FIB$W_NMCTL`009:= 0;
X
X`009FIB`094.FIB$L_ACCTL`009:= FIB$M_WRITE;
X   `032
X`009FIB$DESCR.Class   := 0;
X`009FIB$DESCR.Dtype   := 0;
X`009FIB$DESCR.Length  := SIZE(FIB`094);
X`009FIB$DESCR.Address := IADDRESS(FIB`094);
X   `032
X`009Attributes.RECATTR.Attrib_Size`009:= ATR$S_RECATTR;
X`009Attributes.RECATTR.Attrib_Type`009:= ATR$C_RECATTR;
V`009Attributes.RECATTR.Attrib_Addr`009:= IADDRESS(Header`094.Header.FH$RECATT
XR);
X   `032
X`009Attributes.UCHAR.Attrib_Size`009:= ATR$S_UCHAR;
-+-+-+-+-+ End of part 2 +-+-+-+-+-
--
Regards.    Mike Scott       STL, London Road, Harlow, Essex  CM17 9NA, UK
scott@stl.stc.co.uk <or> ...uunet!mcvax!ukc!stl!scott <or>
PSI%234237100122::SCOTT        phone +44-279-29531 xtn 3133.

