File:  [gforth] / gforth / archive.fs
Revision 1.1: download - view: text, annotated - select for diffs
Mon Jul 30 01:10:41 2012 UTC (6 years, 10 months ago) by pazsan
Branches: MAIN
CVS tags: HEAD
Very simple packed file for distribution into embedded systems

    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,
   34: \ 's' for symlink,
   35: \ 'h' for hardlink
   36: \ rules for directories are: Specify each before first use
   37: 
   38: 4 buffer: fsize
   39: 
   40: : >align ( n -- ) dup sfaligned swap - spaces ;
   41: : .len ( n -- )  fsize le-l! fsize 4 type ;
   42: : .z ( -- )  0 .len ;
   43: : .entry ( addr u char -- addr u )
   44:     >r dup 2 + .len r> emit 2dup type 0 emit dup 2 + >align ;
   45: 
   46: : -scan ( addr u char -- addr' u' )
   47:   >r  BEGIN  dup  WHILE  1- 2dup + c@ r@ =  UNTIL  THEN
   48:   rdrop ;
   49: 
   50: wordlist constant dirs
   51: 
   52: : :dir ( addr u -- )
   53:     get-current >r dirs set-current nextname create r> set-current ;
   54: 
   55: "." :dir
   56: 
   57: : ?dir ( addr u -- )
   58:     '/' -scan dup 0= IF  2drop  EXIT  THEN
   59:     2dup dirs search-wordlist 0= IF
   60: 	2dup recurse
   61: 	'd' .entry .z :dir
   62:     ELSE
   63: 	drop 2drop
   64:     THEN ;
   65: 
   66: : dump-a-file ( addr u -- )
   67:     2dup ?dir
   68:     'f' .entry
   69:     slurp-file dup .len 2dup type dup >align
   70:     drop free throw ;
   71: 
   72: : dump-files ( -- )
   73:     BEGIN  argc @ 1 >  WHILE
   74: 	    next-arg dump-a-file
   75:     REPEAT ;
   76: 
   77: script? [IF]
   78:     argc @ 1 = [IF]
   79: 	." call archive.fs <file list> >output" cr bye
   80:     [ELSE]
   81: 	dump-files bye
   82:     [THEN]
   83: [THEN]

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>