Merge branch 'master' of git://factorcode.org/git/factor

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
 }
 

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
+        100 read-c-string >>name
-    8 read-c-string* tar-trim oct> >>mode
+        8 read-c-string trim-string oct> >>mode
-    8 read-c-string* tar-trim oct> >>uid
+        8 read-c-string trim-string oct> >>uid
-    8 read-c-string* tar-trim oct> >>gid
+        8 read-c-string trim-string oct> >>gid
-    12 read-c-string* tar-trim oct> >>size
+        12 read-c-string trim-string oct> >>size
-    12 read-c-string* tar-trim oct> >>mtime
+        12 read-c-string trim-string oct> >>mtime
-    8 read-c-string* tar-trim oct> >>checksum
+        8 read-c-string trim-string oct> >>checksum
         read1 >>typeflag
-    100 read-c-string* >>linkname
+        100 read-c-string >>linkname
         6 read >>magic
         2 read >>version
-    32 read-c-string* >>uname
+        32 read-c-string >>uname
-    32 read-c-string* >>gname
+        32 read-c-string >>gname
-    8 read tar-trim oct> >>devmajor
+        8 read trim-string oct> >>devmajor
-    8 read tar-trim oct> >>devminor
+        8 read trim-string oct> >>devminor
-    155 read-c-string* >>prefix ;
+        155 read-c-string >>prefix ;
 
-: header-checksum ( seq -- x )
+: checksum-header ( seq -- n )
-    148 cut-slice 8 tail-slice
+    148 cut-slice 8 tail-slice [ sum ] bi@ + 256 + ;
-    [ 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 )
+M: unknown-typeflag summary ( obj -- str )
-    base-dir get prepend-path ;
+    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 ;
     ! <string-writer> [ 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 -- )
+: untar ( path -- )
-    normalize-path dup parent-directory base-dir [
+    normalize-path [ ] [ parent-directory ] bi [
          binary [ (parse-tar) ] with-file-reader
-    ] with-variable ;
+    ] with-directory ;