REBOL [
    Title: "Tar"
    Date: 11-Jan-2013
    Version: 1.1.0
    File: %tar.r
    Author: "Vincent Ecuyer"
    Purpose: {Creates tar archives.}
    Usage: {
        With one file:
            write/binary %test.tar tar %my-file.txt

        With a block of files:
            write/binary %test.tar tar [%my-file.txt %my-dir/my-file.bmp %just-a-dir/]

        You can of course gzip the tar (with %gzip.r):
        
            do %tar.r
            do %gzip.r

            write/binary %test.tgz gzip tar [%some-files ...]

            Resulting archive is usually smaller than a *.zip of the same files
			
        Compatibility tested with 7-Zip 9.20 on WindowsXP SP3 and bsdtar 2.6.2 on MacOSX 10.6.8.
    }
    History: [
        1.0.0 [2-Jan-2004 "First release"]
        1.1.0 [11-Jan-2013 "Fixed end-of-file padding and added r3 comptability"]
    ]
    Library: [
        level: 'advanced
        platform: 'all
        type: [module tool]
        domain: [file-handling files compression]
        tested-under: [
        	view 2.7.8.3.1 on [WinXP]
        	view 2.7.8.2.5 on [Macintosh osx-x86]
        	core 2.101.0.2.5 on [Macintosh osx-x86]
        ]
        support: none
        license: 'public-domain
        see-also: %gzip.r
    ]
]

ctx-tar: context [
    get-modes: either (system/version/2 < 100) [
        get in system/words 'get-modes
    ][
        func [target mode][query/mode target mode]
    ]

    to-octal: func [
        "Converts an integer to an octal issue!."
        value [integer!] "Value to be converted"
        /local t
    ][
        value: join "0" enbase/base at tail do rejoin ["16#{" next mold to-hex value "}"] -4 2
        t: copy {}
        forskip value 3 [
            copy/part value 3
            append t next
            enbase/base do rejoin ["2#{00000" copy/part value 3 "}"] 16
        ]
        t
    ]

    octal-time: func [
        "Returns the octal timestamp."
        value [date!] "Date to encode"
    ][
        to-octal (value - 01/01/1970) * 86400
        + to-integer value/time - value/zone
    ]

    char: func [
        "Encodes the value into a null terminated fixed length string."
        value [any-string! binary!] "String to encode"
        len [integer!] "Required length"
    ][
        copy/part head insert/dup tail to-binary value #{00} len len
    ]

    num: func [
        "Encodes the value into a fixed length octal string."
        value [integer!] "Number to encode"
        len [integer!] "Required length"
    ][
        value: head insert/dup form to-octal value "0" len
        copy skip tail value (0 - len)
    ]

    ;number terminator
    stop: " ^@"

    ;string terminator
    null: "^@"

    ;file access rights
    tar-modes: [
        owner-read   00400  owner-write  00200  owner-exec   00100
        group-read   00040  group-write  00020  group-exec   00010
        world-read   00004  world-write  00002  world-exec   00001
    ]

    set-name: func [
        "Returns the formatted filename."
        value [file!] "File name to format"
    ][char join value null 100]

    set-mode: func [
        "Returns the octal encoded file access mode."
        value [file!] "File to examine"
        /local mode modes
    ][
        modes: get-modes value 'file-modes
        mode: 0
        foreach m [owner-read owner-write owner-exec][
            either find modes m
                [if get-modes value m [mode: mode + tar-modes/:m]]
                [mode: mode + tar-modes/:m]
        ]
        foreach m [
            group-read group-write group-exec
            world-read world-write world-exec
        ][if all [find modes m get-modes value m][mode: mode + tar-modes/:m]]
        mode: form mode
        append mode stop
        insert mode "0000000"
        copy skip tail mode -8
    ]

    set-typeflag: func [
        "Returns the type code for file / directory."
        value [file!] "File name to examine"
    ][either #"/" = last value ["5"]["0"]]

    tar-checksum: func [
        "Returns an octal string with the sum of bytes."
        data [any-string! binary!] "Data to checksum"
        /local r
    ][
        r: 0
        foreach c data [r: r + c]
        join num r 6 stop
    ]

    add-file: func [value [file!] /local r][
        r: to-binary rejoin [
            set-name value
            set-mode value
            "000000" stop
            "000000" stop
            num size? value 11 " "
            octal-time modified? value " "
            "        "          ;  char chksum 8
            set-typeflag value
            char null 100       ;  char linkname 100
            char null 6         ;  char magic 6
            "00"                ;  char version 2
            char null 32        ;  char uname 32
            char null 32        ;  char gname 32
            num 0 6 stop        ;  char devmajor 8
            num 0 6 stop        ;  char devminor 8
            char null 155       ;  char prefix 155
        ]
        change skip r 148 tar-checksum r
        r: head insert/dup tail r #{00} 512 - length? r
        if #"/" <> last value [
            append r either system/version/2 < 100 [read/binary value][read value]
            if 0 <> ((length? r) // 512) [
                r: head insert/dup tail r #{00} 512 - ((length? r) // 512)
            ]
        ]
        r
    ]

    set 'tar func [
        "Builds a tar archive binary from a file or a block of files."
        value [file! block!] "Files to include in archive"
        /local r
    ][
        if file? value [value: reduce [value]]
        r: copy #{}
        foreach file value [append r add-file file]
        head insert/dup tail r #{00} 1024
    ]
]