From 1c9a4ffef363ff08f453d5c654cbc06558e5ebec Mon Sep 17 00:00:00 2001 From: Grahame Grieve Date: Sat, 6 Jan 2024 07:35:20 +1100 Subject: [PATCH] rework fsl_gzip a little per comments from fibonacci --- dependencies/zflate/zflate.pas | 103 ++++++-- dependencies/zflate/zflatefiles.pas | 251 +++++++++++++++++++ library/fhir/fhir_healthcard.pas | 2 +- library/fsl/fsl_gzip.pas | 134 +++------- library/fsl/fsl_npm.pas | 2 +- library/fsl/tests/fsl_tests.pas | 2 +- library/web/fsl_crypto.pas | 4 +- library/web/fsl_npm_cache.pas | 2 +- server/admin/console_managers.pas | 2 +- server/fhirserver.lpi | 6 +- testcases/config/example.cfg.txt | 374 ++++++++++++++-------------- 11 files changed, 572 insertions(+), 310 deletions(-) create mode 100644 dependencies/zflate/zflatefiles.pas diff --git a/dependencies/zflate/zflate.pas b/dependencies/zflate/zflate.pas index c204f17a6..1ee7b1555 100644 --- a/dependencies/zflate/zflate.pas +++ b/dependencies/zflate/zflate.pas @@ -32,7 +32,7 @@ interface uses - SysUtils, ZBase, ZInflate, ZDeflate; + ZBase, ZInflate, ZDeflate; type tzflate = record @@ -56,7 +56,7 @@ tgzipinfo = record footerlen: dword; end; - Tristate = (tNull, tTrue, tFalse); + TBytes = array of byte; const ZFLATE_ZLIB = 1; @@ -107,10 +107,14 @@ function zfindstream(data: pointer; size: dword; var streamtype: dword; var star function gzdeflate(data: pointer; size: dword; var output: pointer; var outputsize: dword; level: dword=9): boolean; //compress whole string to DEFLATE at once function gzdeflate(str: string; level: dword=9): string; +//compress whole bytes to DEFLATE at once +function gzdeflate(bytes : TBytes; level: dword=9): TBytes; //decompress whole DEFLATE buffer at once function gzinflate(data: pointer; size: dword; var output: pointer; var outputsize: dword): boolean; //decompress whole DEFLATE string at once function gzinflate(str: string): string; +//decompress whole DEFLATE bytes at once +function gzinflate(bytes : TBytes): TBytes; //make ZLIB header function makezlibheader(compressionlevel: integer): string; @@ -120,14 +124,14 @@ function makezlibfooter(adler: dword): string; function gzcompress(data: pointer; size: dword; var output: pointer; var outputsize: dword; level: dword=9): boolean; //compress whole string to ZLIB at once function gzcompress(str: string; level: dword=9): string; +//compress whole buffer to ZLIB at once +function gzcompress(bytes : TBytes; level: dword=9) : TBytes; //dempress whole ZLIB buffer at once ! -function gzuncompress(data: pointer; size: dword; readHeader : Tristate; var output: pointer; var outputsize: dword): boolean; +function gzuncompress(data: pointer; size: dword; var output: pointer; var outputsize: dword): boolean; //dempress whole ZLIB string at once function gzuncompress(str: string): string; -//compress whole buffer to ZLIB at once -function gzcompress(bytes : TBytes; level: dword=9) : TBytes; //dempress whole ZLIB buffer at once -function gzuncompress(bytes : TBytes; readHeader : Tristate = tNull) : TBytes; +function gzuncompress(bytes : TBytes) : TBytes; //make GZIP header function makegzipheader(compressionlevel: integer; filename: string=''; comment: string=''): string; @@ -137,15 +141,21 @@ function makegzipfooter(originalsize: dword; crc: dword): string; function gzencode(data: pointer; size: dword; var output: pointer; var outputsize: dword; level: dword=9; filename: string=''; comment: string=''): boolean; //compress whole string to GZIP at once function gzencode(str: string; level: dword=9; filename: string=''; comment: string=''): string; +//compress whole string to GZIP at once +function gzencode(bytes: TBytes; level: dword=9; filename: string=''; comment: string=''): TBytes; //decompress whole GZIP buffer at once function gzdecode(data: pointer; size: dword; var output: pointer; var outputsize: dword): boolean; //decompress whole GZIP string at once function gzdecode(str: string): string; +//decompress whole GZIP string at once +function gzdecode(bytes: TBytes): TBytes; //try to detect buffer format and decompress it at once function zdecompress(data: pointer; size: dword; var output: pointer; var outputsize: dword): boolean; //try to detect string format and decompress it at once function zdecompress(str: string): string; +//try to detect bytes format and decompress it at once +function zdecompress(bytes: TBytes): TBytes; //transalte error code to message function zflatetranslatecode(code: integer): string; @@ -412,6 +422,18 @@ function gzdeflate(str: string; level: dword=9): string; freemem(p); end; +function gzdeflate(bytes: TBytes; level: dword=9): TBytes; +var + p: pointer; + d: dword; +begin + result := nil; + if not gzdeflate(@bytes[0], length(bytes), p, d, level) then exit; + setlength(result, d); + move(p^, result[0], d); + freemem(p); +end; + // -- inflate ----------------------------- function gzinflate(data: pointer; size: dword; var output: pointer; var outputsize: dword): boolean; @@ -458,7 +480,19 @@ function gzinflate(str: string): string; result := ''; if not gzinflate(@str[1], length(str), p, d) then exit; setlength(result, d); - move(p^, result[1], d); + move(p^, result[1], d); + freemem(p); +end; + +function gzinflate(bytes: TBytes): TBytes; +var + p: pointer; + d: dword; +begin + result := nil; + if not gzinflate(@bytes[0], length(bytes), p, d) then exit; + setlength(result, d); + move(p^, result[0], d); freemem(p); end; @@ -544,20 +578,14 @@ function gzcompress(bytes : TBytes; level: dword=9) : TBytes; // -- ZLIB decompress --------------------- -function gzuncompress(data: pointer; size: dword; readHeader : Tristate; var output: pointer; var outputsize: dword): boolean; +function gzuncompress(data: pointer; size: dword; var output: pointer; var outputsize: dword): boolean; var zlib: tzlibinfo; z: tzflate; checksum: dword; - header : boolean; begin result := false; - header := false; - if readHeader <> tFalse then - if zreadzlibheader(data, zlib) then - header := true - else if readHeader = tTrue then - exit(zerror(z, ZFLATE_EZLIBINVALID)); + if not zreadzlibheader(data, zlib) then exit(zerror(z, ZFLATE_EZLIBINVALID)); checksum := swapendian(pdword(data+size-4)^); @@ -565,8 +593,7 @@ function gzuncompress(data: pointer; size: dword; readHeader : Tristate; var out size -= zlib.streamat+zlib.footerlen; if not gzinflate(data, size, output, outputsize) then exit; - if header and (adler32(adler32(0, nil, 0), output, outputsize) <> checksum) then - exit(zerror(z, ZFLATE_ECHECKSUM)); + if (adler32(adler32(0, nil, 0), output, outputsize) <> checksum) then exit(zerror(z, ZFLATE_ECHECKSUM)); result := true; end; @@ -577,19 +604,19 @@ function gzuncompress(str: string): string; d: dword; begin result := ''; - if not gzuncompress(@str[1], length(str), tTrue, p, d) then exit; + if not gzuncompress(@str[1], length(str), p, d) then exit; setlength(result, d); move(p^, result[1], d); freemem(p); end; -function gzuncompress(bytes : TBytes; readHeader : Tristate = tNull) : TBytes; +function gzuncompress(bytes : TBytes) : TBytes; var p: pointer; d: dword; begin result := nil; - if not gzuncompress(@bytes[0], length(bytes), readHeader, p, d) then exit; + if not gzuncompress(@bytes[0], length(bytes), p, d) then exit; try setlength(result, d); move(p^, result[0], d); @@ -686,6 +713,18 @@ function gzencode(str: string; level: dword=9; filename: string=''; comment: str freemem(p); end; +function gzencode(bytes: TBytes; level: dword=9; filename: string=''; comment: string=''): TBytes; +var + p: pointer; + d: dword; +begin + result := nil; + if not gzencode(@bytes[0], length(bytes), p, d, level, filename, comment) then exit; + setlength(result, d); + move(p^, result[0], d); + freemem(p); +end; + // -- GZIP decompress --------------------- function gzdecode(data: pointer; size: dword; var output: pointer; var outputsize: dword): boolean; @@ -722,6 +761,18 @@ function gzdecode(str: string): string; freemem(p); end; +function gzdecode(bytes: TBytes): TBytes; +var + p: pointer; + d: dword; +begin + result := nil; + if not gzdecode(@bytes[0], length(bytes), p, d) then exit; + setlength(result, d); + move(p^, result[0], d); + freemem(p); +end; + // -- decompress anything ----------------- function zdecompress(data: pointer; size: dword; var output: pointer; var outputsize: dword): boolean; @@ -753,6 +804,18 @@ function zdecompress(str: string): string; freemem(p); end; +function zdecompress(bytes: TBytes): TBytes; +var + p: pointer; + d: dword; +begin + result := nil; + if not zdecompress(@bytes[0], length(bytes), p, d) then exit; + setlength(result, d); + move(p^, result[0], d); + freemem(p); +end; + // -- error translation ------------------- function zflatetranslatecode(code: integer): string; diff --git a/dependencies/zflate/zflatefiles.pas b/dependencies/zflate/zflatefiles.pas new file mode 100644 index 000000000..c5ea218ca --- /dev/null +++ b/dependencies/zflate/zflatefiles.pas @@ -0,0 +1,251 @@ +{ MIT License + + Copyright (c) 2023 fibodevy https://github.com/fibodevy + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to + deal in the Software without restriction, including without limitation the + rights to use, copy, modify, merge, publish, distribute, sublicense, and/or + sell copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS + IN THE SOFTWARE. +} + +unit zflatefiles; + +{$mode ObjFPC}{$H+} + +interface + +type + //return true to continue or false to abort + tzprogresscb = function(position, totalsize, outputsize: dword): boolean; + +//compress a file to GZIP +function gzencode_file(src, dst: string; level: dword=9; filename: string=''; comment: string=''; progresscb: tzprogresscb=nil; resolution: dword=100): boolean; +//decompress a GZIP file +function gzdecode_file(src, dst: string; progresscb: tzprogresscb=nil; resolution: dword=100): boolean; + +implementation + +uses zflate; + +// -- GZIP compress ----------------------- + +function gzencode_file(src, dst: string; level: dword=9; filename: string=''; comment: string=''; progresscb: tzprogresscb=nil; resolution: dword=100): boolean; +const + bufsize = 1024*32; +var + z: tzflate; + inpt, outp: file of byte; + buf: array[0..bufsize-1] of byte; + header, footer: string; + d, pos, fsize, outsize: dword; + crc: dword = 0; + failed: boolean = false; + progress: dword = 0; + progressnotified: dword = 0; +begin + result := false; + + if not zdeflateinit(z, level) then exit; + + AssignFile(inpt, src); + {$I-} Reset(inpt); {$I+} + if IOResult <> 0 then exit; + + AssignFile(outp, dst); + {$I-} Rewrite(outp); {$I+} + if IOResult <> 0 then begin + CloseFile(inpt); + exit; + end; + + fsize := FileSize(inpt); + outsize := 0; + pos := 0; + + try + //write header + header := makegzipheader(level, filename, comment); + BlockWrite(outp, header[1], length(header)); + inc(outsize, length(header)); + + while true do begin + BlockRead(inpt, buf[0], bufsize, d); + inc(pos, d); + + crc := crc32b(crc, @buf[0], d); //update crc32 + + if not zdeflatewrite(z, @buf[0], d, d nil then begin + progress := trunc(pos/fsize*resolution); + + if (progress > progressnotified) then begin + if not progresscb(pos, fsize, outsize) then begin + failed := true; + zlasterror := ZFLATE_EABORTED; + exit; + end; + + progressnotified := progress; + end; + end; + + if d < bufsize then break; //eof + end; + + //write footer + footer := makegzipfooter(fsize, crc); + BlockWrite(outp, footer[1], length(footer)); + inc(outsize, length(footer)); + + result := true; + finally + CloseFile(inpt); + CloseFile(outp); + + //delete output file on failure + if failed then begin + AssignFile(outp, dst); + {$I-} Erase(outp); {$I+} + end; + end; +end; + +// -- GZIP decompress --------------------- + +function gzdecode_file(src, dst: string; progresscb: tzprogresscb=nil; resolution: dword=100): boolean; +const + bufsize = 1024*32; +var + z: tzflate; + inpt, outp: file of byte; + buf: array[0..bufsize-1] of byte; + header, footer: string; + d, bytestoread, pos, fsize, outsize: dword; + crc: dword = 0; + gzip: tgzipinfo; + streamsize: dword; + originalsize, checksum: dword; + failed: boolean = false; + progress: dword = 0; + progressnotified: dword = 0; +begin + result := false; + + if not zinflateinit(z) then exit; + + AssignFile(inpt, src); + {$I-} Reset(inpt); {$I+} + if IOResult <> 0 then exit; + + AssignFile(outp, dst); + {$I-} Rewrite(outp); {$I+} + if IOResult <> 0 then begin + CloseFile(inpt); + exit; + end; + + fsize := FileSize(inpt); + + try + //read header + setlength(header, 512); + BlockRead(inpt, header[1], length(header)); + if not zreadgzipheader(@header[1], gzip) then exit; + + //read footer + Seek(inpt, fsize-8); + setlength(footer, 8); + BlockRead(inpt, footer[1], 8); + checksum := pdword(@footer[1])^; + originalsize := pdword(@footer[1+4])^; + + outsize := 0; + pos := 0; + streamsize := fsize-gzip.streamat-gzip.footerlen; + + Seek(inpt, gzip.streamat); + + while true do begin + bytestoread := bufsize; + if bytestoread+pos+gzip.streamat > streamsize then dec(bytestoread, gzip.footerlen); //skip footer + + BlockRead(inpt, buf[0], bytestoread, d); + + inc(pos, d); + + if not zinflatewrite(z, @buf[0], d, d nil then begin + progress := trunc((pos+gzip.streamat)/fsize*resolution); + + if (progress > progressnotified) then begin + if not progresscb(pos+gzip.streamat, fsize, outsize) then begin + failed := true; + zlasterror := ZFLATE_EABORTED; + exit; + end; + + progressnotified := progress; + end; + end; + + if d < bufsize then break; //eof + end; + + if FileSize(outp) <> originalsize then begin + zlasterror := ZFLATE_EOUTPUTSIZE; + failed := true; + exit; + end; + + if crc <> checksum then begin + zlasterror := ZFLATE_ECHECKSUM; + failed := true; + exit; + end; + + result := true; + CloseFile(inpt); + finally + CloseFile(outp); + + //delete output file on failure + if failed then begin + AssignFile(outp, dst); + {$I-} Erase(outp); {$I+} + end; + end; +end; + +end. + diff --git a/library/fhir/fhir_healthcard.pas b/library/fhir/fhir_healthcard.pas index 7b9d47fca..d906ff7a7 100644 --- a/library/fhir/fhir_healthcard.pas +++ b/library/fhir/fhir_healthcard.pas @@ -231,7 +231,7 @@ procedure THealthcareCardUtilities.sign(card: THealthcareCard; jwk : TJWK); finally j.free; end; - bytes := gzcompress(TEncoding.UTF8.GetBytes(payload), false); + bytes := gzip(TEncoding.UTF8.GetBytes(payload), false); card.jws := TJWTUtils.encodeJWT('{"alg":"ES256","zip":"DEF","kid":"'+jwk.id+'"}', bytes, jwt_es256, jwk); end; diff --git a/library/fsl/fsl_gzip.pas b/library/fsl/fsl_gzip.pas index 9f49e2758..c4a533b9c 100644 --- a/library/fsl/fsl_gzip.pas +++ b/library/fsl/fsl_gzip.pas @@ -1,117 +1,65 @@ unit fsl_gzip; -{$i fhir.inc} +{ +Copyright (c) 2011+, HL7 and Health Intersections Pty Ltd (http://www.healthintersections.com.au) +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + * Neither the name of HL7 nor the names of its contributors may be used to + endorse or promote products derived from this software without specific + prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 'AS IS' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, +INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +} + +{$I fhir.inc} + interface uses Classes, SysUtils, zflate, fsl_base, fsl_stream; -function gzcompress(bytes : TBytes; header : boolean; level: dword=9) : TBytes; -function gzuncompress(bytes : TBytes) : TBytes; +{ + for FPC, we use the zflate units by fibonacci. + for delphi, we use delphi's inbuilt ZLib support -// -//function readZLibHeader(stream : TStream) : TBytes; overload; -//function readZLibHeader(b : TBytes) : TBytes; overload; + this unit is to handle the $IFDEF between the two (tbd) +} -implementation +function gzip(bytes : TBytes; header : boolean; level: dword=9) : TBytes; +function ungzip(bytes : TBytes) : TBytes; -function readZLibHeader(b : TBytes) : TBytes; -var - p : int64; - i : integer; -begin - if (length(b) < 10) or (b[0] <> $1F) or (b[1] <> $8B) then - result := b - else - begin - i := 10; - if ((b[3] and $08) > 0) then - begin - repeat - inc(i); - until (i = length(b)) or (b[i] = 0); - inc(i); - end; - if i >= length(b) then - result := b - else - result := copy(b, i, length(b)-i-8); - end; -end; +implementation -function gzcompress(bytes : TBytes; header : boolean; level: dword=9) : TBytes; +function gzip(bytes : TBytes; header : boolean; level: dword=9) : TBytes; begin result := zflate.gzcompress(bytes, level); end; -function gzuncompress(bytes : TBytes) : TBytes; +function ungzip(bytes : TBytes) : TBytes; begin - result := zflate.gzuncompress(readZLibHeader(bytes)); + result := zflate.zdecompress(bytes); if length(result) = 0 then raise EFslException.create('Failed to read compressed content: '+zflatetranslatecode(zlasterror)); - //BytesToFile(bytes, '/Users/grahamegrieve/temp/test.tgz'); - //gzdecode_file('/Users/grahamegrieve/temp/test.tgz', '/Users/grahamegrieve/temp/test.bin'); - //result := FileToBytes('/Users/grahamegrieve/temp/test.bin'); end; -//function InflateRfc1951(b : TBytes) : TBytes; -////var -//// b1, b2 : TBytesStream; -//// z : TZDecompressionStream; -//begin -// result := gzuncompress(readZLibHeader(b)); -// //b1 := TBytesStream.create(b);// readZLibHeader(b)); -// //try -// // z := TZDecompressionStream.create(b1, true); // -15); -// // try -// // z.position := 0; -// // b2 := TBytesStream.Create; -// // try -// // b2.CopyFrom(z, 2); -// // result := b2.Bytes; -// // setLength(result, b2.size); -// // finally -// // b2.free; -// // end; -// // finally -// // z.free; -// // end; -// //finally -// // b1.free; -// //end; -//end; -// -//function DeflateRfc1951(b : TBytes) : TBytes; -//var -// s : TBytesStream; -// z : TZCompressionStream; -//begin -// s := TBytesStream.create(); -// try -// z := TZCompressionStream.create(clMax, s); // , -15); -// try -// z.Write(b, length(b)); -// finally -// z.free; -// end; -// result := s.Bytes; -// setLength(result, s.size); -// finally -// s.free; -// end; -//end; -// -// - -// -// -//function readZLibHeader(stream : TStream) : TBytes; -//begin -// result := readZLibHeader(StreamToBytes(stream)); -// -//end; - end. diff --git a/library/fsl/fsl_npm.pas b/library/fsl/fsl_npm.pas index fc61af769..312e69edf 100644 --- a/library/fsl/fsl_npm.pas +++ b/library/fsl/fsl_npm.pas @@ -1086,7 +1086,7 @@ procedure TNpmPackage.readStream(tgz: TStream; desc: String; progress: TWorkProg b : TBytes; bi : TBytesStream; begin - bs := TBytesStream.create(gzuncompress(streamToBytes(tgz))); + bs := TBytesStream.create(ungzip(streamToBytes(tgz))); try tar := TTarArchive.Create(bs); try diff --git a/library/fsl/tests/fsl_tests.pas b/library/fsl/tests/fsl_tests.pas index 4d7e98346..730932188 100644 --- a/library/fsl/tests/fsl_tests.pas +++ b/library/fsl/tests/fsl_tests.pas @@ -5278,7 +5278,7 @@ function TTarGZParserTests.load(filename : String) : TFslList; begin result := TFslList.Create; try - bs := TBytesStream.create(gzuncompress(fileToBytes(filename))); + bs := TBytesStream.create(ungzip(fileToBytes(filename))); try tar := TTarArchive.Create(bs); try diff --git a/library/web/fsl_crypto.pas b/library/web/fsl_crypto.pas index 2584d57bf..a01c827cf 100644 --- a/library/web/fsl_crypto.pas +++ b/library/web/fsl_crypto.pas @@ -1130,7 +1130,7 @@ class function TJWTUtils.encodeJWT(jwt: TJWT; method: TJWTAlgorithm; key: TJWK; input := JWTBase64URL(TJSONWriter.writeObject(jwt.header)); input := BytesAdd(input, Byte('.')); if zip = 'DEF' then - input := BytesAdd(input, JWTBase64URL(gzcompress(TJSONWriter.writeObject(jwt.payload), false))) + input := BytesAdd(input, JWTBase64URL(gzip(TJSONWriter.writeObject(jwt.payload), false))) else input := BytesAdd(input, JWTBase64URL(TJSONWriter.writeObject(jwt.payload))); case method of @@ -1410,7 +1410,7 @@ class function TJWTUtils.decodeJWT(token: string): TJWT; result.payloadBytes := JWTDeBase64URL(payload); if result.header['zip'] = 'DEF' then - result.payloadBytes := gzuncompress(result.payloadBytes); + result.payloadBytes := ungzip(result.payloadBytes); result.payload := TJSONParser.Parse(result.payloadBytes); result.link; diff --git a/library/web/fsl_npm_cache.pas b/library/web/fsl_npm_cache.pas index 0b0467a2b..d33fc0f80 100644 --- a/library/web/fsl_npm_cache.pas +++ b/library/web/fsl_npm_cache.pas @@ -736,7 +736,7 @@ function TFHIRPackageManager.loadArchive(content: TBytes): TDictionary.Create; - bo := TBytesStream.create(gzuncompress(content)); + bo := TBytesStream.create(ungzip(content)); try work(trunc(bo.Position / bo.Size * 100), false, 'Loading Package'); tar := TTarArchive.Create(bo); diff --git a/server/admin/console_managers.pas b/server/admin/console_managers.pas index cc5e45978..0d7c5213c 100644 --- a/server/admin/console_managers.pas +++ b/server/admin/console_managers.pas @@ -33,7 +33,7 @@ interface uses - SysUtils, Classes, Graphics, UITypes, + SysUtils, Classes, Graphics, System.UITypes, Dialogs, fsl_base, fsl_threads, fsl_utilities, fdb_manager, diff --git a/server/fhirserver.lpi b/server/fhirserver.lpi index 7dc5c3cd6..6820d5c95 100644 --- a/server/fhirserver.lpi +++ b/server/fhirserver.lpi @@ -87,7 +87,7 @@ - + @@ -274,7 +274,7 @@ - + @@ -778,7 +778,7 @@ - + diff --git a/testcases/config/example.cfg.txt b/testcases/config/example.cfg.txt index 9720eed40..d22a9f928 100644 --- a/testcases/config/example.cfg.txt +++ b/testcases/config/example.cfg.txt @@ -1,187 +1,187 @@ -## FHIRServer Config File - -databases - rxn - type: mssql - server: (local) - driver: SQL Server Native Client 11.0 - database: rxnorm - dbr4 - type: mssql - when-testing: true - server: (local) - driver: SQL Server Native Client 11.0 - database: fhir4 - dbr2 - type: mssql - server: (local) - driver: SQL Server Native Client 11.0 - database: fhir2 - dbr3 - type: mssql - server: (local) - driver: SQL Server Native Client 11.0 - database: fhir3 - dbr5 - type: mssql - server: (local) - driver: SQL Server Native Client 11.0 - database: fhir5 - package-server - type: mssql - server: (local) - driver: SQL Server Native Client 11.0 - database: packageserver - -# -terminologies - s-can - type: snomed - source: C:\ProgramData\FHIRServer\snomed_20161031_ca.cache - icd10cm - type: icd10 - source: C:\ProgramData\fhirserver\icd10cm.txt - ndc - type: ndc - version: 20190317 - database: rxn - unii - type: unii - database: dbr3 - sintl2 - type: snomed - source: C:\ProgramData\FHIRServer\snomed_20200131_intl.cache - default: true - scomb - type: snomed - source: C:\ProgramData\fhirserver\snomed_20170306_combined.cache - when-testing: true - loinc - type: loinc - source: C:\ProgramData\fhirserver\loinc-2.68.cache - when-testing: true - lang - type: lang - source: C:\ProgramData\fhirserver\lang.txt - icd10 - type: icd10 - source: C:\ProgramData\fhirserver\icd10.txt - rxnorm - type: rxnorm - database: rxn - s-usa - type: snomed - source: C:\ProgramData\fhirserver\snomed_20160901_us.cache - sintl - type: snomed - source: C:\ProgramData\fhirserver\snomed_20190731_intl.cache - s-aus - type: snomed - source: C:\ProgramData\fhirserver\snomed_20161031_au.cache - icd10vn - type: icd10 - source: C:\ProgramData\fhirserver\icd10vn.txt - ucum - type: ucum - source: C:\work\fhirserver\Exec\64\ucum-essence.xml - when-testing: true - -# -endpoints - packages - type: package - path: /package - database: package-server - r4 - type: r4 - path: /r4 - mode: general - security: open - version: r4 - database: dbr4 - validate: true - when-testing: true - packages: hl7.fhir.r4.examples # 4.0.1 - r2 - type: r2 - path: /r2 - mode: general - security: certificate - version: r2 - database: dbr2 - validate: true - packages: fhir.argonaut.r2 # 1.0.0 - r3 - type: r3 - path: /r3 - mode: terminology - security: read-only - version: r3 - database: dbr3 - packages: hl7.fhir.r3.elements # 3.0.2 - -# -destinations - email - host: smtp.gmail.com - port: 587 - secure: true - username: fhir-server@healthintersections.com.au - password: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - sender: fhir-server@healthintersections.com.au - direct - host: smtp10.phimail-dev.com - port: 587 - pop-host: smtp11.phimail-dev.com - pop-port: 110 - secure: 1 - username: grahame@test.directproject.net - password: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - sender: grahame@test.directproject.net - sms - account: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - token: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - from: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -# -identity-providers - hl7.org - app-id: HL7HealthIntersections - app-secret: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - facebook.com - app-id: 355752811191794 - app-secret: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - like: 1 - google.com - app-id: 940006310138.apps.googleusercontent.com - app-secret: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - api-key: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -# -web - host: local.fhir.org - http: 960 - https: 961 - certname: C:\work\RDPs\certificates\new\fhir.org.crt - cacertname: C:\work\RDPs\certificates\new\fhir.org.int.crt - password: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - oauth: true - googleid: UA-88535340-3 - folder: C:\work\fhirserver\server\web - no-cert: true - package-server: dbr5 - key: C:\work\RDPs\certificates\new\fhir.org.crt - plain-mode: serve - certkey: C:\work\RDPs\certificates\new\fhir.org.key -# -admin - username: g - email: grahame@healthintersections.com.au - owner-sms: - ownername: Health Intersections - scim-salt: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - default-rights: openid,profile,user/*.* - twilio: fhir4 -# -service - run-number: 0 +## FHIRServer Config File + +databases + rxn + type: mssql + server: (local) + driver: SQL Server Native Client 11.0 + database: rxnorm + dbr4 + type: mssql + when-testing: true + server: (local) + driver: SQL Server Native Client 11.0 + database: fhir4 + dbr2 + type: mssql + server: (local) + driver: SQL Server Native Client 11.0 + database: fhir2 + dbr3 + type: mssql + server: (local) + driver: SQL Server Native Client 11.0 + database: fhir3 + dbr5 + type: mssql + server: (local) + driver: SQL Server Native Client 11.0 + database: fhir5 + package-server + type: mssql + server: (local) + driver: SQL Server Native Client 11.0 + database: packageserver + +# +terminologies + s-can + type: snomed + source: C:\ProgramData\FHIRServer\snomed_20161031_ca.cache + icd10cm + type: icd10 + source: C:\ProgramData\fhirserver\icd10cm.txt + ndc + type: ndc + version: 20190317 + database: rxn + unii + type: unii + database: dbr3 + sintl2 + type: snomed + source: C:\ProgramData\FHIRServer\snomed_20200131_intl.cache + default: true + scomb + type: snomed + source: C:\ProgramData\fhirserver\snomed_20170306_combined.cache + when-testing: true + loinc + type: loinc + source: C:\ProgramData\fhirserver\loinc-2.68.cache + when-testing: true + lang + type: lang + source: C:\ProgramData\fhirserver\lang.txt + icd10 + type: icd10 + source: C:\ProgramData\fhirserver\icd10.txt + rxnorm + type: rxnorm + database: rxn + s-usa + type: snomed + source: C:\ProgramData\fhirserver\snomed_20160901_us.cache + sintl + type: snomed + source: C:\ProgramData\fhirserver\snomed_20190731_intl.cache + s-aus + type: snomed + source: C:\ProgramData\fhirserver\snomed_20161031_au.cache + icd10vn + type: icd10 + source: C:\ProgramData\fhirserver\icd10vn.txt + ucum + type: ucum + source: C:\work\fhirserver\Exec\64\ucum-essence.xml + when-testing: true + +# +endpoints + packages + type: package + path: /package + database: package-server + r4 + type: r4 + path: /r4 + mode: general + security: open + version: r4 + database: dbr4 + validate: true + when-testing: true + packages: hl7.fhir.r4.examples # 4.0.1 + r2 + type: r2 + path: /r2 + mode: general + security: certificate + version: r2 + database: dbr2 + validate: true + packages: fhir.argonaut.r2 # 1.0.0 + r3 + type: r3 + path: /r3 + mode: terminology + security: read-only + version: r3 + database: dbr3 + packages: hl7.fhir.r3.elements # 3.0.2 + +# +destinations + email + host: smtp.gmail.com + port: 587 + secure: true + username: fhir-server@healthintersections.com.au + password: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + sender: fhir-server@healthintersections.com.au + direct + host: smtp10.phimail-dev.com + port: 587 + pop-host: smtp11.phimail-dev.com + pop-port: 110 + secure: 1 + username: grahame@test.directproject.net + password: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + sender: grahame@test.directproject.net + sms + account: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + token: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + from: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + +# +identity-providers + hl7.org + app-id: HL7HealthIntersections + app-secret: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + facebook.com + app-id: 355752811191794 + app-secret: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + like: 1 + google.com + app-id: 940006310138.apps.googleusercontent.com + app-secret: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + api-key: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + +# +web + host: local.fhir.org + http: 960 + https: 961 + certname: C:\work\RDPs\certificates\new\fhir.org.crt + cacertname: C:\work\RDPs\certificates\new\fhir.org.int.crt + password: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + oauth: true + googleid: UA-88535340-3 + folder: C:\work\fhirserver\server\web + no-cert: true + package-server: dbr5 + key: C:\work\RDPs\certificates\new\fhir.org.crt + plain-mode: serve + certkey: C:\work\RDPs\certificates\new\fhir.org.key +# +admin + username: g + email: grahame@healthintersections.com.au + owner-sms: + ownername: Health Intersections + scim-salt: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + default-rights: openid,profile,user/*.* + twilio: fhir4 +# +service + run-number: 0