From 53397f4f7c8024f2784a55760dd884ff49f8ffd1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 15 Apr 2009 19:31:02 -0500 Subject: [PATCH 1/2] update tar --- extra/tar/tar.factor | 79 +++++++++++++++++++++++--------------------- 1 file changed, 42 insertions(+), 37 deletions(-) diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index 37c022fe43..297157c08b 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -1,8 +1,10 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: combinators io io.files io.files.links io.directories io.pathnames io.streams.string kernel math math.parser continuations namespaces pack prettyprint sequences strings system tools.hexdump io.encodings.binary summary accessors -io.backend byte-arrays ; +io.backend byte-arrays io.streams.byte-array splitting ; IN: tar CONSTANT: zero-checksum 256 @@ -10,37 +12,35 @@ CONSTANT: block-size 512 TUPLE: tar-header name mode uid gid size mtime checksum typeflag linkname magic version uname gname devmajor devminor prefix ; + ERROR: checksum-error ; -SYMBOLS: base-dir filename ; +: trim-string ( seq -- newseq ) [ "\0 " member? ] trim ; -: tar-trim ( seq -- newseq ) [ "\0 " member? ] trim ; - -: read-c-string* ( n -- str/f ) +: read-c-string ( n -- str/f ) read [ zero? ] trim-tail [ f ] when-empty ; : read-tar-header ( -- obj ) \ tar-header new - 100 read-c-string* >>name - 8 read-c-string* tar-trim oct> >>mode - 8 read-c-string* tar-trim oct> >>uid - 8 read-c-string* tar-trim oct> >>gid - 12 read-c-string* tar-trim oct> >>size - 12 read-c-string* tar-trim oct> >>mtime - 8 read-c-string* tar-trim oct> >>checksum - read1 >>typeflag - 100 read-c-string* >>linkname - 6 read >>magic - 2 read >>version - 32 read-c-string* >>uname - 32 read-c-string* >>gname - 8 read tar-trim oct> >>devmajor - 8 read tar-trim oct> >>devminor - 155 read-c-string* >>prefix ; + 100 read-c-string >>name + 8 read-c-string trim-string oct> >>mode + 8 read-c-string trim-string oct> >>uid + 8 read-c-string trim-string oct> >>gid + 12 read-c-string trim-string oct> >>size + 12 read-c-string trim-string oct> >>mtime + 8 read-c-string trim-string oct> >>checksum + read1 >>typeflag + 100 read-c-string >>linkname + 6 read >>magic + 2 read >>version + 32 read-c-string >>uname + 32 read-c-string >>gname + 8 read trim-string oct> >>devmajor + 8 read trim-string oct> >>devminor + 155 read-c-string >>prefix ; -: header-checksum ( seq -- x ) - 148 cut-slice 8 tail-slice - [ sum ] bi@ + 256 + ; +: checksum-header ( seq -- n ) + 148 cut-slice 8 tail-slice [ sum ] bi@ + 256 + ; : read-data-blocks ( tar-header -- ) dup size>> 0 > [ @@ -60,29 +60,34 @@ SYMBOLS: base-dir filename ; ] if ; : parse-tar-header ( seq -- obj ) - [ header-checksum ] keep over zero-checksum = [ + [ checksum-header ] keep over zero-checksum = [ 2drop \ tar-header new 0 >>size 0 >>checksum ] [ - [ read-tar-header ] with-string-reader + binary [ read-tar-header ] with-byte-reader [ checksum>> = [ checksum-error ] unless ] keep ] if ; ERROR: unknown-typeflag ch ; -M: unknown-typeflag summary ( obj -- str ) - ch>> 1string "Unknown typeflag: " prepend ; -: tar-prepend-path ( path -- newpath ) - base-dir get prepend-path ; +M: unknown-typeflag summary ( obj -- str ) + ch>> [ "Unknown typeflag: " ] dip prefix ; : read/write-blocks ( tar-header path -- ) binary [ read-data-blocks ] with-file-writer ; +: prepend-current-directory ( path -- path' ) + current-directory get prepend-path ; + ! Normal file : typeflag-0 ( header -- ) - dup name>> tar-prepend-path read/write-blocks ; + dup name>> dup "global_pax_header" = [ + drop [ read-data-blocks ] with-string-writer drop + ] [ + prepend-current-directory read/write-blocks + ] if ; ! Hard link : typeflag-1 ( header -- ) unknown-typeflag ; @@ -99,7 +104,7 @@ M: unknown-typeflag summary ( obj -- str ) ! Directory : typeflag-5 ( header -- ) - name>> tar-prepend-path make-directories ; + name>> prepend-current-directory make-directories ; ! FIFO : typeflag-6 ( header -- ) unknown-typeflag ; @@ -139,7 +144,7 @@ M: unknown-typeflag summary ( obj -- str ) drop ; ! [ read-data-blocks ] keep ! >string [ zero? ] trim-tail filename set - ! filename get tar-prepend-path make-directories ; + ! filename get prepend-current-directory make-directories ; ! Multi volume continuation entry : typeflag-M ( header -- ) unknown-typeflag ; @@ -157,7 +162,7 @@ M: unknown-typeflag summary ( obj -- str ) : typeflag-X ( header -- ) unknown-typeflag ; : (parse-tar) ( -- ) - block-size read dup length 512 = [ + block-size read dup length block-size = [ parse-tar-header dup typeflag>> { @@ -189,7 +194,7 @@ M: unknown-typeflag summary ( obj -- str ) drop ] if ; -: parse-tar ( path -- ) - normalize-path dup parent-directory base-dir [ +: untar ( path -- ) + normalize-path [ ] [ parent-directory ] bi [ binary [ (parse-tar) ] with-file-reader - ] with-variable ; + ] with-directory ; From d03621d435a2deb85b99d78f903d6bc82b4f79e0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 15 Apr 2009 19:36:44 -0500 Subject: [PATCH 2/2] Remove reference to GLU from factor.sh --- build-support/factor.sh | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/build-support/factor.sh b/build-support/factor.sh index 2fec39f14a..53aab9ad04 100755 --- a/build-support/factor.sh +++ b/build-support/factor.sh @@ -139,7 +139,6 @@ check_library_exists() { } check_X11_libraries() { - check_library_exists GLU check_library_exists GL check_library_exists X11 check_library_exists pango-1.0 @@ -491,7 +490,7 @@ make_boot_image() { } install_build_system_apt() { - sudo apt-get --yes install libc6-dev libpango1.0-dev libx11-dev xorg-dev glutg3-dev wget git-core git-doc rlwrap gcc make + sudo apt-get --yes install libc6-dev libpango1.0-dev libx11-dev xorg-dev wget git-core git-doc rlwrap gcc make check_ret sudo }