Script Library: codec-gzip.r

Script Library: 1247 scripts
codec-gzip.r

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

        Returns gzipped data [binary!] :

            >> encode 'gzip data

            arguments:
                data : data to encode [binary! string! file! url!]

        Returns gunzipped data as a binary :

            >> decode 'gzip data

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

        Returns gunzipped data as a block, in the format [%filename [date-time #{data} comment 'os]] :

            >> decode/as 'gzip data block!

        Returns gunzipped data as a string! :

            >> decode/as 'gzip data string!

        Examples:

            write/binary %codec-gzip.gz encode 'gzip %codec-gzip.r
            original-source: decode 'gzip read/binary %codec-gzip.gz

            ; returns 'gzip
            encoding? gzipped-source
    }
    Library: [
        level: 'intermediate
        platform: 'all
        type: [module tool codec]
        domain: [compression file-handling files]
        tested-under: [
            view 1.2.1.3.1 on [Windows11]
            view 2.7.8.3.1 on [Windows11]
            face 1.2.48.3.1 on [Windows11]
        ]
        support: none
        license: 'bsd
        see-also: [%codecs.r %gzip.r %gunzip.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 [
    as-binary: either value? in system/words 'as-binary [get in system/words 'as-binary] [:to-binary]
    as-string: either value? in system/words 'as-string [get in system/words 'as-string] [:to-string]

    crc-long: [
                 0   1996959894  -301047508 -1727442502   124634137  1886057615
        -379345611  -1637575261   249268274  2044508324  -522852066 -1747789432
         162941995   2125561021  -407360249 -1866523247   498536548  1789927666
        -205950648  -2067906082   450548861  1843258603  -187386543 -2083289657
         325883990   1684777152   -43845254 -1973040660   335633487  1661365465
         -99664541  -1928851979   997073096  1281953886  -715111964 -1570279054
        1006888145   1258607687  -770865667 -1526024853   901097722  1119000684
        -608450090  -1396901568   853044451  1172266101  -589951537 -1412350631
         651767980   1373503546  -925412992 -1076862698   565507253  1454621731
        -809855591  -1195530993   671266974  1594198024  -972236366 -1324619484
         795835527   1483230225 -1050600021 -1234817731  1994146192    31158534
       -1731059524   -271249366  1907459465   112637215 -1614814043  -390540237
        2013776290    251722036 -1777751922  -519137256  2137656763   141376813
       -1855689577   -429695999  1802195444   476864866 -2056965928  -228458418
        1812370925    453092731 -2113342271  -183516073  1706088902   314042704
       -1950435094    -54949764  1658658271   366619977 -1932296973   -69972891
        1303535960    984961486 -1547960204  -725929758  1256170817  1037604311
       -1529756563   -740887301  1131014506   879679996 -1385723834  -631195440
        1141124467    855842277 -1442165665  -586318647  1342533948   654459306 
       -1106571248   -921952122  1466479909   544179635 -1184443383  -832445281 
        1591671054    702138776 -1328506846  -942167884  1504918807   783551873 
       -1212326853  -1061524307  -306674912 -1698712650    62317068  1957810842 
        -355121351  -1647151185    81470997  1943803523  -480048366 -1805370492 
         225274430   2053790376  -468791541 -1828061283   167816743  2097651377 
        -267414716  -2029476910   503444072  1762050814  -144550051 -2140837941 
         426522225   1852507879   -19653770 -1982649376   282753626  1742555852 
        -105259153  -1900089351   397917763  1622183637  -690576408 -1580100738 
         953729732   1340076626  -776247311 -1497606297  1068828381  1219638859 
        -670225446  -1358292148   906185462  1090812512  -547295293 -1469587627 
         829329135   1181335161  -882789492 -1134132454   628085408  1382605366 
        -871598187  -1156888829   570562233  1426400815  -977650754 -1296233688 
         733239954   1555261956 -1026031705 -1244606671   752459403  1541320221
       -1687895376   -328994266  1969922972    40735498 -1677130071  -351390145
        1913087877     83908371 -1782625662  -491226604  2075208622   213261112 
       -1831694693   -438977011  2094854071   198958881 -2032938284  -237706686 
        1759359992    534414190 -2118248755  -155638181  1873836001   414664567 
       -2012718362    -15766928  1711684554   285281116 -1889165569  -127750551 
        1634467795    376229701 -1609899400  -686959890  1308918612   956543938 
       -1486412191   -799009033  1231636301  1047427035 -1362007478  -640263460
        1088359270    936918000 -1447252397  -558129467  1202900863   817233897 
       -1111625188   -893730166  1404277552   615818150 -1160759803  -841546093 
        1423857449    601450431 -1285129682 -1000256840  1567103746   711928724 
       -1274298825  -1022587231  1510334235   755167117
    ]

    right-shift-8: func [
        "Right-shifts the value by 8 bits and returns it."
        value [integer!] "The value to shift"
    ][
        either negative? value [
            -1 xor value and -256 / 256 xor -1 and 16777215
        ][
            -256 and value / 256
        ]
    ]
    
    update-crc: func [
        "Returns the data crc."
        data [any-string!] "Data to checksum"
        crc [integer!] "Initial value"
    ][
        foreach char data [
             crc: (right-shift-8 crc) xor pick crc-long crc and 255 xor char + 1
        ]
    ]

    crc-32: func [
        "Returns a CRC32 checksum."
        data [any-string! binary!] "Data to checksum"
    ] either system/version/2 < 100 [[
        either empty? data [#{00000000}][
            load rejoin ["#{" to-hex -1 xor update-crc data -1 "}"]
        ]
    ]][[
        either empty? data [#{00000000}][
            copy skip to-binary checksum/method to-binary data 'crc32 4
        ]
    ]]

    timestamp: func [
        "Returns the gzip timestamp."
        value [date!] "Date to encode."
    ][
        copy/part head reverse do rejoin ["#{"
            next mold to-hex (value - 01/01/1970) * 86400
            + to-integer value/time - value/zone
            "}"
        ] 4
    ]

;===

    to-bin: func [value][load rejoin ["#{" to-hex value "}"]]
    set?: func [value bit][not zero? value and to-integer 2 ** bit]
    os-codes: [
        'FAT 'Amiga 'VMS 'Unix 'VM/CMS 'Atari-TOS 'HPFS 'Macintosh
        'Z-System 'CP/M 'TOPS-20 'NTFS 'QDOS 'Acorn-RISCOS
    ]

    register-codec [
        name: 'gzip
        type: 'compression
        title: "GZip compressed data"
        version: system/script/header/version
        suffixes: [%.gz %.tgz]
        encode: func [
            data [binary! string! file! url!] /as name [any-string!] 
            /local date
        ] [
            date: none
            either any [file? data url? data as] [
                either as [name: to-file name] [
                    name: last split-path data
                    date: modified? data
                    data: read/binary data
                ]
            ] [data: as-binary data]

            head change skip tail rejoin [#{1F8B08}
                either name [#{08}][#{00}]
                timestamp any [date now]
                #{02FF}
                either name [rejoin [to-binary name #{00}]][#{}]
                next next compress data
            ] -8 head reverse crc-32 data
        ]
        decode: func [
            [catch]
            data [binary! file! url!]
            /as format [word! datatype!]
            /local flags os filename filecomment time size r
        ] [
            if not all [value? 'view? view?] [throw make error! "/View needed"]

            if any [file? data url? data] [data: read/binary data]
        
            if data/1 <> 31  [throw make error! "Bad ID"]
            if data/2 <> 139 [throw make error! "Bad ID"]
            if data/3 <> 8   [throw make error! "Unknown Method"]

            flags: data/4

            time: to-integer head reverse copy/part skip data 4 4
            time: either zero? time [none][
                01-01-1970/0:0:0 + now/zone + to-time time
            ]

            os: pick os-codes data/10 + 1

            filename: filecomment: none

            data: skip data 10
            if set? flags 2 [ ; extra?
                data: skip data 2
                data: skip data data/2 * 256 + data/1 + 2
            ]
            if set? flags 3 [ ; name?
                filename: data
                data: find/tail data #"^@"
                filename: copy/part filename back data
            ]
            if set? flags 4 [ ; comment?
                filecomment: data
                filecomment: find/tail data #"^@"
                filecomment: copy/part filecomment back data
            ]
            if set? flags 1 [ ; crc-16?
                data: skip data 2
            ]

            size: to-integer head reverse copy skip tail data -4

            data: copy/part data skip tail data -8

            data: to-binary rejoin [
                #{89504E47} #{0D0A1A0A} ; signature
                #{0000000D} ; IHDR length
                "IHDR" ; type: header
                to-bin size ; width = uncompressed size
                #{00000001} ; height = 1 line
                #{08} ; bit depth
                #{00} ; color type = grayscale
                #{00} ; compression method
                #{00} ; filter method = none
                #{00} ; interlace method = no interlace
                #{00000000} ; no checksum
                to-bin 2 + 6 + length? data ; length
                "IDAT" ; type: data
                #{789C} ; zlib header
                #{00 0100 FEFF 00} ; 0 = no filter for scanline
                data
                #{00000000} ; no checksum
                #{00000000} ; length
                "IEND" ; type: end
                #{00000000} ; no checksum
            ]

            if error? try [data: load data][
                throw make error! "Unable to decompress"
            ]
            
            r: make binary! size
            repeat i size [insert tail r to-char pick pick data i 1]

            either all [as find [block! block] to-word :format] [
                reduce [
                    either filename [to-file filename][none]
                    reduce [
                        time
                        r
                        either filecomment [to-string comment][none]
                        either os [os]['Unknown]
                    ]
                ]
            ][either all [as find [string! string] to-word :format] [as-string r][r]]
        ]
        identify: func [data [binary!]] [parse/all data [#{1F8B} to end]]
        verbose: false
    ]
]