88 lines
3.2 KiB
Common Lisp
88 lines
3.2 KiB
Common Lisp
;;;; PMSF-Lib --- PMSF Common Lisp Utility Library
|
|
;;;; This is copyrighted software. See documentation for terms.
|
|
;;;;
|
|
;;;; doc.lisp --- Documentation of file origins and versions
|
|
;;;;
|
|
;;;; $Id$
|
|
|
|
(cl:in-package #:pmsf-lib)
|
|
|
|
;;;; %File Description:
|
|
;;;;
|
|
;;;; This file provides mechanisms to record the id of files compiled
|
|
;;;; and loaded to create a runtime image.
|
|
;;;;
|
|
|
|
(defvar *file-versions* nil
|
|
"Associaton list of loaded file-ids.")
|
|
|
|
(defmacro file-version (system id-string)
|
|
"Register the File-Id `id-string' in the system `system'."
|
|
;; On CMUCL we use `ext:file-comment' in addition to our own
|
|
;; tracking, so that the File-Id gets embedded in the fasl, and can
|
|
;; be seen in descriptions of functions, etc. See the documentation
|
|
;; of `ext:file-comment' for more details.
|
|
`(progn
|
|
#+cmucl
|
|
(ext:file-comment ,id-string)
|
|
;; Do compile-time processing by MD5 checksumming the file itself.
|
|
(process-file-version ',system *load-truename* ',id-string
|
|
',*compile-file-truename*
|
|
',(md5:md5sum-file *compile-file-truename*))))
|
|
|
|
(defun process-file-version (system file-name id-string
|
|
source-file-name source-md5)
|
|
"Load-time part of `file-version'."
|
|
(let* ((system-list (or (assoc system *file-versions*)
|
|
(let ((sys (cons system nil)))
|
|
(push sys *file-versions*)
|
|
sys)))
|
|
(file-entry (or (assoc file-name (cdr system-list) :test #'equal)
|
|
(let ((entry (cons file-name nil)))
|
|
(push entry (cdr system-list))
|
|
entry))))
|
|
(setf (cdr file-entry)
|
|
(list id-string (md5:md5sum-file file-name)
|
|
source-file-name source-md5))
|
|
nil))
|
|
|
|
(defun get-file-versions (system)
|
|
(let ((system-list (assoc system *file-versions*)))
|
|
(if system-list
|
|
(cdr system-list)
|
|
(error "System ~S not found!" system))))
|
|
|
|
(defun list-file-versions (system)
|
|
(loop for (path id) in (get-file-versions system)
|
|
do
|
|
(format t "~20A ~A~%" path id)
|
|
initially
|
|
(format t "~&~20A ~A~2%" "Path" "Version-Id")))
|
|
|
|
(defun list-file-checksums (system)
|
|
(loop for (path nil md5) in (get-file-versions system)
|
|
do
|
|
(format t "~40A ~{~2,'0X~}~%" path (coerce md5 'list))
|
|
initially
|
|
(format t "~&~40A ~32A~2%" "Path" "MD5")))
|
|
|
|
(defun list-source-checksums (system)
|
|
(loop for (nil nil nil source-path source-md5) in (get-file-versions system)
|
|
do
|
|
(format t "~40A ~{~2,'0X~}~%" source-path (coerce source-md5 'list))
|
|
initially
|
|
(format t "~&~40A ~32A~2%" "Source-Path" "MD5")))
|
|
|
|
(defun md5-file-versions (system)
|
|
(md5:md5sum-string
|
|
(with-output-to-string (stream)
|
|
(loop for (path id md5) in (sort (copy-list (get-file-versions system))
|
|
#'string< :key
|
|
(lambda (x)
|
|
(if (pathnamep (car x))
|
|
(namestring (car x))
|
|
(car x))))
|
|
do
|
|
(format stream "~A!~A!~{~2,'0X~}~%" path id (coerce md5 'list))))
|
|
:external-format :utf-8))
|