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: 'bsd 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 ] ] ]