Return to archive.fs CVS log

Up to [gforth] / gforth

Small change in archive format

    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 (can't create now),
   35: \ 'h' for hardlink (can't create now)
   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 )
   43:     >r dup 2 + .len r> emit 2dup type 0 emit ;
   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: 
   54: "." :dir \ no need to create .
   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 -- )
   66:     2dup ?dir  'f' .entry
   67:     slurp-file dup .len 2dup type drop free throw ;
   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]