--- /dev/null
+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 >> $@
--- /dev/null
+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.
+====
--- /dev/null
+;; 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))
--- /dev/null
+;; 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))
+
--- /dev/null
+;; 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)
projects / rrq / newlisp / packnl.git / commitdiff