Annotation of gforth/archive.fs, revision 1.2
1.1 pazsan 1: \ very simple archive format 29jul2012py
2:
3: \ Copyright (C) 2012 Free Software Foundation, Inc.
4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation, either version 3
10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program. If not, see http://www.gnu.org/licenses/.
19:
20: \ the intention for this format is to ship Gforth's files to
21: \ limited systems in a very simple format (simpler than tar)
22: \ so that unpacking is totally trivial.
23: \ File system capabilities expected are similar to vfat
24: \ no date stamp is given
25: \ the file is supposed to be compressed with zlib afterwards
26:
27: \ Format of each file:
28: \ 32 bit len type filename\0 - counted+zero-terminated, aligned to 4 bytes
29: \ 32 bit size, little endian, aligend to 4 bytes
30: \ file contents, plus alignment to 4 bytes
31: \ type is:
32: \ 'f' for file,
33: \ 'd' for directory,
1.2 ! pazsan 34: \ 's' for symlink (can't create now),
! 35: \ 'h' for hardlink (can't create now)
1.1 pazsan 36: \ rules for directories are: Specify each before first use
37:
38: 4 buffer: fsize
39:
40: : .len ( n -- ) fsize le-l! fsize 4 type ;
41: : .z ( -- ) 0 .len ;
42: : .entry ( addr u char -- addr u )
1.2 ! pazsan 43: >r dup 2 + .len r> emit 2dup type 0 emit ;
1.1 pazsan 44:
45: : -scan ( addr u char -- addr' u' )
46: >r BEGIN dup WHILE 1- 2dup + c@ r@ = UNTIL THEN
47: rdrop ;
48:
49: wordlist constant dirs
50:
51: : :dir ( addr u -- )
52: get-current >r dirs set-current nextname create r> set-current ;
53:
1.2 ! pazsan 54: "." :dir \ no need to create .
1.1 pazsan 55:
56: : ?dir ( addr u -- )
57: '/' -scan dup 0= IF 2drop EXIT THEN
58: 2dup dirs search-wordlist 0= IF
59: 2dup recurse
60: 'd' .entry .z :dir
61: ELSE
62: drop 2drop
63: THEN ;
64:
65: : dump-a-file ( addr u -- )
1.2 ! pazsan 66: 2dup ?dir 'f' .entry
! 67: slurp-file dup .len 2dup type drop free throw ;
1.1 pazsan 68:
69: : dump-files ( -- )
70: BEGIN argc @ 1 > WHILE
71: next-arg dump-a-file
72: REPEAT ;
73:
74: script? [IF]
75: argc @ 1 = [IF]
76: ." call archive.fs <file list> >output" cr bye
77: [ELSE]
78: dump-files bye
79: [THEN]
80: [THEN]
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>