;;;; -*- mode:lisp;coding:utf-8; -*-

(ql:quickload :cl-ppcre)
(ql:quickload :com.informatimago.common-lisp)
(use-package :com.informatimago.common-lisp.cesarum.file)
(use-package :com.informatimago.common-lisp.interactive.browser)

#+ccl (import 'ccl:run-program)
(defun process-output-stream (process)
  #+ccl (ccl:external-process-output-stream process))
(defun dirname (pathname)
  (make-pathname :name nil :type nil :version nil :defaults pathname))


(defun ldd (program-path)
  (with-open-stream (ldd (process-output-stream
                          (run-program "ldd" (list program-path)
                                       :element-type 'character
                                       :output :stream :input nil :error nil)))
    (loop
      :for line = (read-line ldd nil nil)
      :while line
      :for libraries = (nth-value 1 (ppcre:scan-to-strings "^[ 	]+((.*) => )?(.*) \\(0x[0-9a-f]+\\)$" line))
      :unless  (equal "" (aref libraries 2))
      :collect (aref libraries 2))))




(defparameter *lisp-binary-path*   "/data/src/languages/ccl/ccl-1.8-linuxx86/lx86cl64")
(defparameter *target-mount-point* "/tmp/lep/")


(defun relativize-pathname (pathname)
  (make-pathname :directory (cons :relative (rest (pathname-directory pathname)))
                 :defaults pathname))

(defun test/relativize-pathname ()
 (assert (equalp (relativize-pathname "/tmp/toto/titi")     #P"tmp/toto/titi"))
 (assert (equalp (relativize-pathname "/tmp/toto/titi.tar") #P"tmp/toto/titi.tar"))
 (assert (equalp (relativize-pathname "/tmp/toto/")         #P"tmp/toto/"))
 ;; (assert (equalp (relativize-pathname "/")                  #P""))
 :success)


(defun target (dirpath)
  (merge-pathnames (relativize-pathname dirpath)
                   *target-mount-point*
                   nil))

(defun test/target ()
  (assert (equalp (let ((*target-mount-point* "/tmp/base/"))
                    (dir "/toto/titi/"))
                  #P"/tmp/base/toto/titi/"))
  :success)

(test/relativize-pathname)
(test/dir)


(defun write-fstab (pathname entries)
  (with-open-file (fstab pathname
                         :direction :output
                         :if-does-not-exist :create
                         :if-exists :supersede
                         :element-type 'character)
    (let ((*print-pretty* nil))
      (loop
        :for (device mount-point fs-type options dump pass)
        :in entries
        :do (format fstab "~10A ~10A ~10A ~20A ~4D ~4D~%"
                    device mount-point fs-type options dump pass)))))

(defun generate-init ()
  (with-open-file (generate "generate-init.lisp")
    (run-program *lisp-binary-path* (list "-norc")
                 :input (merge-pathnames "generate-init.lisp" *default-pathname-defaults* nil)
                 :output t
                 :wait t)))


(defun lepbootstrap ()
  (cd (dirname (or *load-pathname* #P"~/src/public/lep/install/")))

  (dolist (dir '( "/bin/" "/etc/" "/sbin/" "/lib/" "/tmp/"))
    (mkdir (target dir)))

  ;;   (generate-init)

  (copy-file "init" (target "/sbin/init")
             :if-exists :supersede
             :element-type '(unsigned-byte 8))
  (dolist (library (ldd *lisp-binary-path*))
    (let ((destination (target library)))
      (ensure-directories-exist destination)
      (copy-file library destination
                 :if-exists :supersede
                 :element-type '(unsigned-byte 8))))

  (write-fstab (target "/etc/fstab")
               '(("/dev/root" "/" "ext3" "defaults,noatime" 0 1))))







(lepbootstrap)
ViewGit