commit cd8c1b3528215e91fa4d3727c096ee0ad2f3d92d
parent 66f0ce613a90556b4f87e203cb2c301159859553
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 13 Apr 2023 20:59:19 -0400
ar/tar: new unit
See doc/ar/tar.
Diffstat:
3 files changed, 132 insertions(+), 2 deletions(-)
diff --git a/fs/ar/tar.fs b/fs/ar/tar.fs
@@ -0,0 +1,46 @@
+: parseoctal ( a u -- n )
+ 0 swap for ( a res ) 8 * over c@ '0' - + dip 1+ | next nip ;
+
+struct[ TarRecord
+ $200 const RECORDSZ
+
+ 100 sfield' zname
+ 8 sfield' omode \ o prefix means "octal", ASCII octal.
+ 8 sfield' ouid
+ 8 sfield' ogid
+ 12 sfield' ofilesz
+ 12 sfield' omtime
+ 8 sfield' checksum
+ sfieldb type
+ 100 sfield' zlinkname
+
+ : :empty? ( self -- f ) @ not ;
+ : :dir? type '5' = ;
+ create _buf 100 allot
+ : :name ( self -- str )
+ zname 0 over 100 [c]? ( zname len )
+ 2dup 1- + c@ '/' = if 1- then ( zname len )
+ dup _buf c!+ swap move _buf ;
+ : :filesize ( self -- sz ) ofilesz 11 parseoctal ;
+]struct
+
+struct[ Tar
+ sfield drv
+ sfield sec0
+ sfield sec
+ SZ &+ buf(
+ : :sec! ( sec self -- ) 2dup to sec bi buf( | drv Drive :sec@ ;
+ : :new ( sec0 drv -- tar )
+ here rot> dup , over , -1 , Drive secsz allot ( tar sec ) over :sec! ;
+ : :record ( self -- rec ) buf( ;
+ : :rewind dup sec0 swap :sec! ;
+ : :next ( self -- rec )
+ dup :record dup TarRecord :empty? if abort" end of tar chain" then
+ TarRecord :filesize TarRecord RECORDSZ /mod swap bool + 1+ ( self sec+ )
+ over sec + over :sec! :record ;
+ : :find ( name self -- rec? f ) >r \ V1=self
+ V1 :rewind V1 :record begin ( name rec )
+ dup TarRecord :empty? not while
+ TarRecord :name over s= not while ( name )
+ V1 :next repeat drop r> :record 1 else drop rdrop 0 then ;
+]struct
diff --git a/fs/doc/ar/tar.txt b/fs/doc/ar/tar.txt
@@ -0,0 +1,84 @@
+# Tape archive (tar) tools
+
+The /ar/tar.fs unit contains tool to manipulate archives of the "tar" format
+originating from UNIX. It does so through two structs.
+
+## TarRecord
+
+This wraps a 512 bytes tar header record containing metadata about the
+represented element. You are supposed to use it with a pointer to the actual
+data. For example, if you've read a tar header sector to "here", then "here
+TarRecord :name" will yield the name of the record.
+
+Fields:
+
+zname
+omode
+ouid
+ogid
+ofilesz
+omtime
+checksum
+zlinkname
+ Pointer to the address corresponding to the record field.
+
+type
+ Character corresponding to the record type ('5'=directory, NULL=file)
+
+Methods:
+
+:empty? ( self -- f )
+ Whether the record is empty (starts with null characters).
+
+:dir? ( self -- f )
+ Whether the record is a directory (type = '5')
+
+:name ( self -- str )
+ Name of the file or directory. If the name has a trailing '/', it is removed.
+ This name is stored in a static buffer that is overwritten at each :name call.
+
+:filesize ( self -- sz )
+ Parsed version of "ofilesz". This is the file size in bytes that follow the
+ record.
+
+## Tar
+
+This structure iterates over a Drive, interpreting sectors as tar records. At
+creation, it is supplied a Drive struct as well as an "origin" sector. Is is
+then possible to iterate over record through :next or to find a record with a
+specific name through :find.
+
+Fields:
+
+drv
+ Drive we're iterating through
+
+sec0
+ Origin sector number
+
+sec
+ Sector of the current record
+
+buf(
+ Buffer with the contents of the current sector
+
+Methods:
+
+:new ( sec0 drv -- tar )
+ Create new Tar with specified Drive and origin sector.
+
+:sec! ( sec self -- )
+ Read and set current sector.
+
+:record ( self -- rec )
+ TarRecord we're currently pointing at.
+
+:rewind ( self -- )
+ Set current sector to origin sector.
+
+:next ( self -- rec )
+ Advance current sector to next record and return it.
+
+:find ( name self -- rec? f )
+ Rewind, then iterate over record over a record of the specified name is found.
+ If found, f=1 and rec is set. Otherwise, f=0 and rec is absent.
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -377,8 +377,8 @@ create _ 0 , EMETA_8B , EMETA_16B ,
struct[ Drive
sfield secsz
sfield seccnt
- smethod :sec@
- smethod :sec!
+ smethod :sec@ ( sec dst drv -- )
+ smethod :sec! ( sec src drv -- )
]struct
struct[ IO
