diff --git a/src/package.lisp b/src/package.lisp index 76c6a0b..a598b8d 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -416,11 +416,12 @@ :html->text)) (defpackage :resources-utils - (:use :cl + (:use + :cl :cl-ppcre - :config + :config :constants - :filesystem-utils + :filesystem-utils :text-utils) (:nicknames :res) (:export @@ -434,6 +435,18 @@ :get-sys-config-file :get-data-file)) +(defpackage :zip-info + (:use + :cl + :cl-ppcre + :config + :constants + :filesystem-utils + :text-utils + :misc-utils) + (:export + :zip-file-p)) + (defpackage :crypto-utils (:use :cl :alexandria diff --git a/src/zip-info.lisp b/src/zip-info.lisp new file mode 100644 index 0000000..f7531d7 --- /dev/null +++ b/src/zip-info.lisp @@ -0,0 +1,88 @@ +;; tinmop: an humble gemini and pleroma client +;; Copyright (C) 2021 cage + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(in-package :zip-info) + +(alexandria:define-constant +byte-type+ '(unsigned-byte 8) :test #'equalp) + +(alexandria:define-constant +eocd-signature+ #x06054b50 :test #'=) + +(alexandria:define-constant +eocd-signature-size+ 4 :test #'=) + +(alexandria:define-constant +eocd-number-of-disk+ 2 :test #'=) + +(alexandria:define-constant +eocd-number-of-disk-w/start-eocd+ 2 :test #'=) + +(alexandria:define-constant +eocd-tot-no-entry-cd-this-disk+ 2 :test #'=) + +(alexandria:define-constant +eocd-tot-no-entry-cd+ 2 :test #'=) + +(alexandria:define-constant +eocd-cd-size+ 4 :test #'=) + +(alexandria:define-constant +eocd-cd-offset+ 4 :test #'=) + +(alexandria:define-constant +eocd-zip-file-comment-length+ 2 :test #'=) + +(alexandria:define-constant +eocd-fixed-size+ (+ +eocd-signature-size+ + +eocd-number-of-disk+ + +eocd-number-of-disk-w/start-eocd+ + +eocd-tot-no-entry-cd-this-disk+ + +eocd-tot-no-entry-cd+ + +eocd-cd-size+ + +eocd-cd-offset+ + +zip-file-comment-length+) + :test #'=) + +(alexandria:define-constant +eocd-zip-file-comment-offset+ (- +eocd-fixed-size+ + +zip-file-comment-length+) + :test #'=) + +(defun open-file (path) + (open path :element-type +byte-type+ :direction :input :if-does-not-exist :error)) + +(defun close-file (stream) + (close stream)) + +(defmacro with-open-zip-file ((stream path) &body body) + `(let ((,stream (open-file ,path))) + (unwind-protect + (progn ,@body) + (close-file ,stream)))) + +(defun read-bytes->int (stream size) + (misc:byte->int (loop repeat size collect (read-byte stream)))) + +(defun zip-file-p (path) + (let ((file-size (file-size path)) + (eocd-start nil)) + (when (>= file-size +eocd-fixed-size+) + (with-open-zip-file (stream path) + (loop named signature-finder for position + from (- file-size +eocd-signature-size+) + downto 0 do + (file-position stream position) + (let ((maybe-signature (read-bytes->int stream +eocd-signature-size+))) + (when (= maybe-signature +eocd-signature+) + (setf eocd-start position) + (return-from signature-finder t)))) + (when eocd-start + (let* ((eocd-fixed-part-offset (+ eocd-start +eocd-fixed-size+)) + (eocd-offset-minus-zip-comment (- eocd-fixed-part-offset + +eocd-zip-file-comment-length+))) + (file-position stream eocd-offset-minus-zip-comment) + (let ((comment-size (read-bytes->int stream +zip-file-comment-length+))) + (= (+ eocd-fixed-part-offset comment-size) + file-size)))))))) diff --git a/tinmop.asd b/tinmop.asd index e05df77..44ebf8f 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -67,6 +67,7 @@ (:file "html-utils") (:file "crypto-utils") (:file "resources-utils") + (:file "zip-info") (:file "interfaces") (:file "mtree-utils") (:file "bs-tree")