Archive version of: codec-tar.r ... version: 1 ... vincentecuye 7-Mar

Amendment note: new script || Publicly available? Yes

REBOL [	
    Name: 'codec-tar
	Version: 1.0.0
	Title: "Codec: tar archives"
	Author: Rights: "Annick ECUYER"
    File: %codec-tar.r
    Date: 7-Mar-2025
	History: [
        7-Mar-2025 "Annick" {Initial version}
	]
    Usage:  {
        To use with %codecs.r, but defines a minimal interface if it's missing.

        Returns archieved data [binary!] :

            >> encode 'tar data

            arguments:
                data : data to encode [block! file! url!]

            the block! format allows these forms :

            1) file list : [%file1 %file2 %file3]
            2) file-data pairs : [%file1 "sample data" %file2 #{AABBCC00...}] 
            3) file [modification-date data] or 
               file [data modification-date] : [%file1 [1-Jan-2025/13:00 #{AFAB...}]]

        Returns unarchived data as a block :

            >> decode 'tar data

            arguments:
                data : data to decode [binary! file! url!]

            returns:
                a block! with the format :
                [%filename1 [modification-date file-data file-permissions type-of-entry] %filename2 [...] ...]

        Examples:

            write/binary %tar-codec.tar encode 'tar [%codec-tar.r %codecs.r]
            r: decode 'tar read/binary %tar-codec.tar
    }
    Library: [
        level: 'intermediate
        platform: 'all
        type: [module tool codec]
        domain: [file-handling files compression]
        tested-under: [
        	view 2.7.8.3.1 on [Windows11]
        	view 1.2.1.3.1 on [Windows11]
        ]
        support: none
        license: 'public-domain
        see-also: [%codecs.r %tar.r]
    ]
]

if any [not value? 'component? not component? 'codecs] [
    if not value? 'codecs [codecs: copy []]
    if not value? 'register-codec [
        register-codec: func [body][
            body: context body
            either select codecs body/name [
                change next find codecs body/name body
            ][append codecs reduce [body/name body]]
        ]
        encode: func [codec value /as type] [
            either as [codecs/:codec/encode/as value type][codecs/:codec/encode value]
        ]
        decode: func [codec value /as type] [
            either as [codecs/:codec/decode/as value type][codecs/:codec/decode value]
        ]
        encoding?: func [value [binary!]] [
            foreach [name codec] codecs [
                if all [value? in codec 'identify codec/identify value] [return name]
            ]
            none
        ]
    ]
]

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 result
    ] [
        result: copy "" 
        until [
            insert result to-string value // 8 
            value: to-integer value / 8 
            zero? value
        ] 
        result
    ]

    from-octal: func [
        "Converts an octal string to an integer!."
        value [binary! string! issue!] "Value to be converted"
        /local result
    ] [
        result: 0 
        while [all [not tail? value not find " ^-^/^@" to-char value/1]] [
            result: result * 8 + value/1 - #"0"
            value: next value
        ] 
        result
    ]

    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
    ]

    from-unix-time: func [
        "Returns the timestamp."
        value [number!] "Seconds from 01/01/1970"
    /local result
    ][
        result: 01/01/1970
        result/time: 00:00:00 + value + now/zone
        result/zone: now/zone

        result
    ]

    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 rejoin [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!] /data content /modified date [date!] /local r][
        r: to-binary rejoin [
            set-name value
            either data [rejoin ["000777" stop]][set-mode value]
            "000000" stop
            "000000" stop
            num either content [length? content] [size? value] 11 " "
            octal-time any [all [modified date] all [data now] 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 data [content] [read/binary value]
            if 0 <> ((length? r) // 512) [
                r: head insert/dup tail r #{00} 512 - ((length? r) // 512)
            ]
        ]
        r
    ]

    get-file: func [
        value [binary!] 
    /local 
        r name mode size entry-size time checksum flag
    ][
        parse/all value [
            copy name 100 skip (name: to-file copy/part trim/head name any [find name "^@" tail? name])
            copy mode 8 skip   (mode: to-issue copy/part trim/head mode any [find mode "^@" find mode " " tail? mode])
            8 skip
            8 skip
            copy size 12 skip  (size: from-octal trim/head size)
            copy time 12 skip  (if error? try [time: from-unix-time from-octal trim/head time] [time: from-unix-time 0])
            copy checksum 8 skip ()
            copy flag 1 skip (flag: to-char flag)
        ]
        entry-size: (512 * size / 512) + any [all [not zero? size // 512 512 - (size // 512)] 0]
        reduce [
            name
            reduce [
                time either find "0^@" flag [copy/part skip value 512 size] [none] 
                mode flag
            ]
            skip value 512 + entry-size
        ]
    ]


    register-codec [ 
        name: 'tar
        type: 'compression
        title: "tar archive"
        version: system/script/header/version
        suffixes: [%.tar]
        encode: func [data [block! file!] /local file content date r] [
            if file? data [data: reduce [data]]
            r: copy #{}
            parse data [any [
                set file file! set content [binary! | string!] (append r add-file/data file content) |
                set file file! into [
                    [set content [binary! | string!] set date date!] |
                    [set date date! set content [binary! | string!]]
                ] (append r add-file/data/modified file content date) |
                set file file! (append r add-file file)
            ]]
            head insert/dup tail r #{00} 1024
        ]
        decode: func [data [binary! file! url!] /local result entry] [
            if any [file? data url? data] [data: read/binary data]

            result: copy []
            while [all [not tail? data 0 <> data/1]] [
                entry: get-file data
                append result entry/1
                append/only result entry/2
                data: entry/3
            ]
            result
        ]
    ]
]