From: Ralph Ronnquist Date: Tue, 14 Dec 2021 03:22:04 +0000 (+1100) Subject: initial X-Git-Tag: 0.1.0~23 X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=3dcbdf45070be29c4dec5217bcb141d8ee96ac47;p=rrq%2Fnewlisp%2Fpacknl.git initial --- 3dcbdf45070be29c4dec5217bcb141d8ee96ac47 diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..3c81875 --- /dev/null +++ b/Makefile @@ -0,0 +1,5 @@ +packnl: packnl.lsp incore.lsp main-args.lsp + newlisp -x incore.lsp $@ + chmod a+x $@ + echo 'xxxxxxxxxxxxxxxxxxxxxx''xxxxxxxxxxxxxxxxxx' >> $@ + for F in $^ ; do echo "$$F\n$$(stat -c %s $$F)" ; cat $$F ; done >> $@ diff --git a/README.adoc b/README.adoc new file mode 100644 index 0000000..656dcf9 --- /dev/null +++ b/README.adoc @@ -0,0 +1,36 @@ +The packnl Project +================== + +*packnl* is a command to pack a newlisp application into a binary +using the embedding feature of newlisp. Such a packed binary will have ++incore.lsp+ as embedded script, and then extended with the +application files in a "simple archive" format. The first application +file is used as "main script" that is loaded automatically. The +remaining application files are set up to be available as overriding +members for the +load+, +read-file+ and +file?+ functions. + +.packnl -w binary ( file | -a name | -A name )* +==== +This commandline form is used for preparing a binary with the given +files. The nominated files will be appended to the binary in the given +order. + +* The *-a* option is used for registering the members of an +ar+ style +archive to subseqently be selectively nominated for inclusion into the +binary. + +* The *-A* option is used for including all members of an +ar+ style +archive. +==== + +.packnl -t binary +==== +This commandline form is used for reviewing a packed binary as a list +of its included members. +==== + +.packnl -u binary directory +==== +This commandline form is used for unpacking a packed binary into a +given target directory. +==== diff --git a/incore.lsp b/incore.lsp new file mode 100644 index 0000000..6ba2561 --- /dev/null +++ b/incore.lsp @@ -0,0 +1,76 @@ +;; This code is intended for an embedded binary with an "archive" of +;; files appended to it. The appended archive is marked by a array of +;; 40 "x", and consists by archive elements the format of +;; "pathname\nsize\nbytes[size]". +;; +;; When there is an in-core archive, then the first member will be +;; invoked as "main script". +;; +;; archives:archives is a hashmap for loadable files +;; core:core is the running binary file +;; archive:main is the name of the first on-core member +;; archive:incore is the byte position into core for the archive + +(new Tree 'archives) + +(define core:core (read-file (main-args 0))) + +(context 'archive) + +(setf main nil) + +(constant 'AR "/usr/bin/ar") + +(define (archive:archive PATH) + ;;(write-line 2 (string (list 'archive PATH))) + (map (fn (F) (archives F PATH) F) + (exec (format "%s t %s" AR PATH)))) + +(define (get-ar PATH MEMBER) + ;;(write-line 2 (string (list 'get-ar PATH MEMBER))) + (let ((I (pipe)) (O (pipe)) (DATA "") (ALL "") + (SUB (fn (I O) + (close (I 1)) (close (O 0)) (close 0) + (process (format "%s p %s %s" AR PATH MEMBER) (I 0) (O 1))))) + (fork (SUB I O)) + (close (O 1)) (close (I 0)) (close (I 1)) + (while (> (or (read (O 0) DATA 1000000) 0)) (extend ALL DATA)) + (close (I 0)) + ALL)) + +(define (get PATH MEMBER) + (if (list? PATH) ((PATH 0) (PATH 1) core) + (ends-with PATH ".a") (get-ar PATH MEMBER))) + +;; Discover and load an in-core archive by means of a marker row of 40 +;; "x", and then a series of pathname\nsize\nbytes[size] members. +(if (find (dup "x" 40) core nil 391704) + (let ((P (+ $it 41))) ; skip marker and newline + (constant 'incore P) + (while (regex "([^\n]+)\n([^\n]+)\n" core 0 P) + (let ((N $1) (S (int $2)) (L (length $0))) + (inc P L) + (unless main (setf main N)) + (archives N (list P S)) + (inc P S)))) + (write-line 2 (string "not packed"))) + +(context MAIN) + +(constant + 'load + (letex (LOAD load) + (fn () (if (archives (args 0)) + (eval-string (archive:get $it (args 0)) MAIN) + (LOAD (args 0))))) + 'read-file + (letex (READ-FILE read-file) + (fn () + (if (archives (args 0)) (archive:get $it (args 0)) + (READ-FILE (args 0))))) + 'file? + (letex (FILE? file?) + (fn () (if (archives (args 0)) true (FILE? (args 0))))) + ) + +(when archive:main (load archive:main) (exit 0)) diff --git a/main-args.lsp b/main-args.lsp new file mode 100644 index 0000000..89280d6 --- /dev/null +++ b/main-args.lsp @@ -0,0 +1,18 @@ +;; Utility function to process the main arguments into options and other +;; using a given template + +; The input arguments (less options +(constant 'ARGS (1 (main-args))) + +; The command line options replaced with actuals, in order. +(constant + 'OPTIONS + (map (fn (O) + (if (collect + (if (match (flat (list '* O '*)) ARGS) + (let ((A ($it 0)) (B ($it -1)) + (C (slice $it 1 (- (length $it) 2)))) + (constant 'ARGS (append A B)) C))) + (cons O $it))) + OPTIONS)) + diff --git a/packnl.lsp b/packnl.lsp new file mode 100644 index 0000000..e49d943 --- /dev/null +++ b/packnl.lsp @@ -0,0 +1,80 @@ +;; Utility to "compile" a list of lsp files into a self-contained +;; binary, which is an embedded newlisp binary with the same embedding +;; script as binnl itself. +;; +;; Usage: [ -r ] binary ( -a archive | member )* +;; +;; The script processes the arguments from left to right to form then +;; named binary with the named members appended. +;; +;; Use '-a archive' to make the nominated ar style archive members +;; available subsequently for embedding. +;; +;; Use '-A archive' to embed all members of the nominated ar style +;; archive. +;; +;; Use '-r' to overwrite an existing binary + +;; The first embedded member will be the "main script". +;; + +(constant + 'OPTIONS + '(("-w" ?) ; write new file + ("-u" ? ?) ; unpack members to given directory + ("-t" ?) ; merely list packed members of + )) + +(load "main-args.lsp") + +(define (compile-file M (D (read-file M))) + (unless D + (write-line 2 (format "*** Mising %s .. aborting" M)) + (exit 1)) + (append-file BINARY (format "%s\n%d\n" M (length D))) + (append-file BINARY D)) + +(define (compile-ar A M) + (let ((MEMBERS (archive M))) + (if (= A "-A") (dolist (M MEMBERS) (compile-file M))))) + +(define (compile BINARY MEMBERS) + (write-file BINARY (0 archive:incore core)) ; includes the marker + (exec (format "chmod a+x %s" BINARY)) + (let ((A nil)) + (dolist (M MEMBERS) + ;;(write-line 1 (string "[" M "]" (archives))) + (case M + ("-a" (setf A "-a")) + ("-A" (setf A "-A")) + (true (if A (compile-ar A M) (compile-file M)) + (setf A nil)))) + )) + +(define (decompile BINARY DIR) + (let ((D (read-file BINARY))) + (when D + (let ((P (find (dup "x" 40) D))) + (when P + (inc P 41) + (while (regex "([^\n]+)\n([^\n]+)\n" D 0 P) + (let ((N $1) (S (int $2)) (L (length $0))) + (inc P L) + (if DIR (write-file (string DIR "/" N) (P S D)) (println N)) + (inc P S)))))))) + +;; clear the compiler index +;; Drop the compile members from the index +(dolist (M (map first (archives))) (archives M nil)) + +(when (or (!= 1 (length (clean null? OPTIONS))) + (!= 2 (length ((clean null? OPTIONS) 0)))) + (write-line 2 "Please use one of -w -u or -t") + (exit 1)) + +(cond + ((OPTIONS 0) (compile (OPTIONS 0 1 0) ARGS)) + ((OPTIONS 1) (decompile (OPTIONS 1 1 0) (OPTIONS 1 1 1))) + ((OPTIONS 2) (decompile (OPTIONS 2 1 0) nil))) + +(exit 0)