X-Git-Url: http://git.kpe.io/?p=lml2.git;a=blobdiff_plain;f=downloads.lisp;h=21473d15f8366b8bd585b2efc342ca9b58670975;hp=855505b0a948a85c69dab5825836388052e7c6b7;hb=9c5e52ab7792dc7e57d02141c797d95b31b23039;hpb=1156e876ab634a4634a472c79bdfa8756f583e80 diff --git a/downloads.lisp b/downloads.lisp index 855505b..21473d1 100644 --- a/downloads.lisp +++ b/downloads.lisp @@ -26,34 +26,34 @@ (defun strip-dl-base (file base) (let ((fdir (pathname-directory file)) - (bdir (pathname-directory base))) + (bdir (pathname-directory base))) (make-pathname :name (pathname-name file) :type (pathname-type file) - :directory + :directory (when (> (length fdir) (length bdir)) - (append '(:absolute) - (subseq fdir (length bdir) (length fdir))))))) - + (append '(:absolute) + (subseq fdir (length bdir) (length fdir))))))) + (defun print-file (file dl-data) (let ((size 0) - (modtime (date-string (file-write-date file))) - (basename (namestring - (make-pathname :name (pathname-name file) - :type (pathname-type file)))) - (dl-name (strip-dl-base file (dl-data-base dl-data))) - (sig-path (concatenate 'string (namestring file) ".asc"))) + (modtime (date-string (file-write-date file))) + (basename (namestring + (make-pathname :name (pathname-name file) + :type (pathname-type file)))) + (dl-name (strip-dl-base file (dl-data-base dl-data))) + (sig-path (concatenate 'string (namestring file) ".asc"))) (when (plusp (length basename)) (with-open-file (strm file :direction :input) - (setq size (round (/ (file-length strm) 1024)))) + (setq size (round (/ (file-length strm) 1024)))) (lml-format "~A" - (dl-data-url dl-data) dl-name basename) + (dl-data-url dl-data) dl-name basename) (lml-princ "") (lml-format " (~A, ~:D KB)" modtime size) (when (probe-file sig-path) - (setf (dl-data-signed dl-data) t) - (lml-format " [Signature]" - (dl-data-url dl-data) dl-name)) + (setf (dl-data-signed dl-data) t) + (lml-format " [Signature]" + (dl-data-url dl-data) dl-name)) (html :br)))) (defun display-header (name url) @@ -68,10 +68,10 @@ (lml-princ "

GPG Public Key

") (lml-princ "Use this key to verify file signtatures")) (lml-princ "")) - + (defun print-sect-title (title dl-data) (lml-format "~A" - (dl-data-indent dl-data) title (dl-data-indent dl-data))) + (dl-data-indent dl-data) title (dl-data-indent dl-data))) (defun match-base-name? (name base-name) (let ((len-base-name (length base-name))) @@ -80,7 +80,7 @@ (defun match-base-name-latest? (name base-name) (let* ((latest (concatenate 'string base-name "-latest")) - (len-latest (length latest))) + (len-latest (length latest))) (when (>= (length name) len-latest) (string= name latest :end1 len-latest :end2 len-latest)))) @@ -99,9 +99,9 @@ (defun display-one-section (title pat dl-data) (let ((files (sort-pathnames - (filter-latest - (filter-against-base (directory pat) (dl-data-name dl-data)) - (dl-data-name dl-data))))) + (filter-latest + (filter-against-base (directory pat) (dl-data-name dl-data)) + (dl-data-name dl-data))))) (when files (print-sect-title title dl-data) (lml-princ "
") @@ -111,24 +111,24 @@ (defun display-sections (sects dl-data) (when sects (let ((title (car sects)) - (value (cadr sects))) + (value (cadr sects))) (if (consp title) - (dolist (sect sects) - (display-sections sect dl-data)) - (if (consp value) - (progn - (print-sect-title title dl-data) - (incf (dl-data-indent dl-data)) - (display-sections value dl-data) - (decf (dl-data-indent dl-data))) - (display-one-section title value dl-data)))))) - + (dolist (sect sects) + (display-sections sect dl-data)) + (if (consp value) + (progn + (print-sect-title title dl-data) + (incf (dl-data-indent dl-data)) + (display-sections value dl-data) + (decf (dl-data-indent dl-data))) + (display-one-section title value dl-data)))))) + (defun display-page (pkg-name pkg-base dl-base dl-url sects) (let ((dl-data (make-dl-data :indent 3 - :base dl-base - :url dl-url - :name pkg-base - :signed nil))) + :base dl-base + :url dl-url + :name pkg-base + :signed nil))) (display-header pkg-name dl-url) (dolist (sect sects) (display-sections sect dl-data)) @@ -137,38 +137,38 @@ (defun std-dl-page (pkg-name pkg-base dl-base dl-url) (let ((base (parse-namestring dl-base))) (let ((tgz-path (make-pathname :defaults base :type "gz" :name :wild)) - (zip-path (make-pathname :defaults base :type "zip" :name :wild)) - (doc-path (make-pathname :defaults base :type "pdf" :name :wild))) + (zip-path (make-pathname :defaults base :type "zip" :name :wild)) + (doc-path (make-pathname :defaults base :type "pdf" :name :wild))) (display-page pkg-name pkg-base dl-base dl-url - `(("Manual" ,doc-path) - ("Source Code" - (("Unix (.tar.gz)" ,tgz-path) - ("Windows (.zip)" ,zip-path)))))))) - + `(("Manual" ,doc-path) + ("Source Code" + (("Unix (.tar.gz)" ,tgz-path) + ("Windows (.zip)" ,zip-path)))))))) + (defun full-dl-page (pkg-name pkg-base dl-base dl-url) (let ((base (parse-namestring dl-base))) (let ((tgz-path (make-pathname :defaults base :type "gz" :name :wild)) - (zip-path (make-pathname :defaults base :type "zip" :name :wild)) - (doc-path (make-pathname :defaults base :type "pdf" :name :wild)) - (deb-path (merge-pathnames - (make-pathname :directory '(:relative "linux-debian") - :type :wild :name :wild) - base)) - (rpm-path (merge-pathnames - (make-pathname :directory '(:relative "linux-rpm") - :type :wild :name :wild) - base)) - (w32-path (merge-pathnames - (make-pathname :directory '(:relative "win32") - :type :wild :name :wild) - base))) + (zip-path (make-pathname :defaults base :type "zip" :name :wild)) + (doc-path (make-pathname :defaults base :type "pdf" :name :wild)) + (deb-path (merge-pathnames + (make-pathname :directory '(:relative "linux-debian") + :type :wild :name :wild) + base)) + (rpm-path (merge-pathnames + (make-pathname :directory '(:relative "linux-rpm") + :type :wild :name :wild) + base)) + (w32-path (merge-pathnames + (make-pathname :directory '(:relative "win32") + :type :wild :name :wild) + base))) (display-page pkg-name pkg-base dl-base dl-url - `(("Manual" ,doc-path) - ("Source Code" - (("Unix (.tar.gz)" ,tgz-path) - ("Windows (.zip)" ,zip-path))) - ("Binaries" - (("Linux Binaries" - (("Debian Linux" ,deb-path) - ("RedHat Linux" ,rpm-path))) - ("Windows Binaries" ,w32-path)))))))) + `(("Manual" ,doc-path) + ("Source Code" + (("Unix (.tar.gz)" ,tgz-path) + ("Windows (.zip)" ,zip-path))) + ("Binaries" + (("Linux Binaries" + (("Debian Linux" ,deb-path) + ("RedHat Linux" ,rpm-path))) + ("Windows Binaries" ,w32-path))))))))