Commit ea8f1370 authored by Eric Timmons's avatar Eric Timmons
Browse files

Update msi builder

parent 1f594d1a
......@@ -10,66 +10,87 @@
(in-package #:clpm-scripts)
(setup-asdf "default")
(setup-asdf)
(asdf:load-system :clpm-asdf)
(asdf:load-system :alexandria)
(asdf:load-system :s-xml)
(asdf:load-system :uuid)
(defun files-for-installer (o s)
(let* ((staging-directory (asdf:component-pathname (asdf-release-ops::release-system-release-module o s)))
(input-files (asdf:input-files o s)))
(values (mapcar (lambda (pn)
(enough-namestring pn staging-directory))
input-files)
staging-directory)))
(defun gen-uuid ()
(format nil "~A" (uuid:make-v4-uuid)))
(defun sanitize-id (id)
(substitute #\_ #\- id))
(defun directory-tree (pn component-base-id file-base-id dir-base-id)
(let* ((files (directory (merge-pathnames "*.*" pn)))
(dirs (directory (merge-pathnames "*/" pn)))
(dir-name (car (last (pathname-directory pn))))
(defun gather-all-files (file-list dir-list component-base-id dir-name file-base-id dir-base-id)
(let* ((direct-files (remove-if #'pathname-directory file-list))
(dirs nil)
(dir-id (uiop:strcat dir-base-id "." dir-name))
(out `(("Directory" "Name" ,dir-name "Id" ,(sanitize-id dir-id))))
(out `(,@(when (equal dir-name "bin")
`((("Component" "Id" "CLPM_SetPATH"
"Guid" "5514D118-8FAD-497C-ACFB-BAC6C0161E69"
"DiskId" "1"
"Win64" "yes")
(("CreateFolder"))
(("Environment" "Id" "Env_PATH"
"System" "yes"
"Action" "set"
"Name" "PATH"
"Part" "last"
"Value" "[BINDIR]")))))
("Directory" "Name" ,dir-name
"Id" ,(cond
((null dir-list)
"INSTALLDIR")
((equal dir-name "bin")
"BINDIR")
(t
(sanitize-id dir-id))))))
(component-name (sanitize-id (uiop:strcat component-base-id "_" dir-name)))
(component-names (list component-name))
(component (list (list (list "CreateFolder"))
(list "Component"
"Id" component-name
"Guid" (gen-uuid)
"DiskId" "1"
"Win64" "yes"))))
(dolist (file files)
(unless (or (uiop:directory-pathname-p file)
(equal "fasl" (pathname-type file)))
(let ((enough (enough-namestring file pn)))
(push `(("File" "Name" ,enough
"Id" ,(sanitize-id (uiop:strcat file-base-id "." dir-name "." enough))
"Source" ,(enough-namestring file *build-root-pathname*)))
component))))
(component `((("CreateFolder"))
("Component"
"Id" ,component-name
"Guid" ,(gen-uuid)
"DiskId" "1"
"Win64" "yes"))))
(dolist (not-direct-file (set-difference file-list direct-files))
(let ((first-dir (second (pathname-directory not-direct-file))))
(push (subseq not-direct-file (1+ (length first-dir)))
(alexandria:assoc-value dirs first-dir :test #'equal))))
(dolist (file direct-files)
(push `(("File" "Name" ,file
"Id" ,(sanitize-id (uiop:strcat file-base-id "." dir-name "." file))
"Source" ,(format nil "~{~A/~}~A" dir-list file)))
component))
(push (nreverse component) out)
(dolist (dir dirs)
(multiple-value-bind (subdir-tree sub-component-names)
(directory-tree dir component-name (uiop:strcat file-base-id "." dir-name) dir-id)
(gather-all-files (cdr dir) (append dir-list (list (car dir)))
component-name (car dir) (uiop:strcat file-base-id "." (car dir))
dir-name)
(setf component-names (append sub-component-names component-names))
(push subdir-tree out)))
(values (nreverse out) component-names)))
(defun directory-files (pn)
(let ((files (directory (merge-pathnames "*.*" pn)))
(out))
(dolist (file files)
(unless (or (uiop:directory-pathname-p file)
(equal "fasl" (pathname-type file)))
(push `(("File" "Name" ,(enough-namestring file pn)
"Source" ,(enough-namestring file *build-root-pathname*)))
out)))
out))
(defun build-wxs ()
(multiple-value-bind (src-dir-tree src-dir-component-names)
(directory-tree (merge-pathnames "lib/clpm/src/" *build-root-pathname*)
"CLPM_Src" "CLPM_SrcFile" "CLPM_SrcDir")
(defun build-wxs (files)
(multiple-value-bind (dirs components)
(gather-all-files files nil "CLPM" (clpm-asdf::base-version) "CLPMFile" "CLPMDir")
`(("Wix" "xmlns" "http://schemas.microsoft.com/wix/2006/wi")
(("Product" "Id" "*"
"Name" "Common Lisp Package Manager (CLPM)"
"Version" "0.3.6"
;; We can only use base version in WXS.
"Version" ,(clpm-asdf::base-version)
"Manufacturer" "https://www.clpm.dev"
"UpgradeCode" "D499FD17-A05C-41F8-837E-8B1BF4C4403B"
"Language" "1033")
......@@ -99,57 +120,13 @@
"Name" "PFiles")
(("Directory" "Id" "BaseFolder"
"Name" "CLPM")
(("Directory" "Id" "INSTALLDIR")
(("Directory" "Id" "BINDIR"
"Name" "bin")
(("Component" "Id" "CLPM_SetPATH"
"Guid" "5514D118-8FAD-497C-ACFB-BAC6C0161E69"
"DiskId" "1"
"Win64" "yes")
(("CreateFolder"))
(("Environment" "Id" "Env_PATH"
"System" "yes"
"Action" "set"
"Name" "PATH"
"Part" "last"
"Value" "[BINDIR]")))
(("Component" "Id" "CLPM_Bin"
"Guid" "E7F4D949-DEBC-4FF9-9D60-D455BC11F606"
"DiskId" "1"
"Win64" "yes")
(("File" "Name" "clpm.exe"
"Source" "bin/clpm.exe"))))
(("Directory" "Id" "LIBDIR"
"Name" "lib")
(("Component" "Id" "CLPM_Libs"
"Guid" "35C91C7A-ED22-40B5-A761-730C57CCF803"
"DiskId" "1"
"Win64" "yes")
(("CreateFolder"))
,@(directory-files (merge-pathnames "lib/clpm/" *build-root-pathname*)))
(("Directory" "Id" "ClientDir"
"Name" "client")
(("Component" "Id" "CLPM_Client"
"Guid" "6B847710-C813-4E8E-861B-7C0B767F4C36"
"DiskId" "1"
"Win64" "yes")
,@(directory-files (merge-pathnames "lib/clpm/client/" *build-root-pathname*))))
(("Directory" "Id" "SrcDir"
"Name" "src")
,src-dir-tree))))))
,dirs)))
(("Feature" "Id" "Minimal"
"Title" "CLPM Executable"
"ConfigurableDirectory" "INSTALLDIR"
"Level" "1")
(("ComponentRef" "Id" "CLPM_Bin"))
(("ComponentRef" "Id" "CLPM_Libs"))
(("ComponentRef" "Id" "CLPM_Client"))
(("Feature" "Id" "InstallSourceCode"
"Level" "1"
"Title" "Install Source Code")
,@(mapcar (lambda (id) `(("ComponentRef" "Id" ,id))) src-dir-component-names))
,@(mapcar (lambda (id) `(("ComponentRef" "Id" ,id))) components)
(("Feature" "Id" "SetPath"
"Level" "1"
"Title" "Set Environment Variable: PATH")
......@@ -160,11 +137,34 @@
"Value" "INSTALLDIR"))
(("UIRef" "Id" "WixUI_FeatureTree"))))))
(defun write-wxs ()
(with-open-file (s (merge-pathnames "clpm.wxs" *build-root-pathname*)
:if-exists :supersede :direction :output)
(format s "<?xml version='1.0'?>~%")
(s-xml:print-xml (build-wxs) :stream s :pretty t)))
(print (build-wxs))
(write-wxs)
(defun make-msi ()
(multiple-value-bind (relative-files staging-directory)
(files-for-installer (asdf:make-operation 'asdf-release-ops:dynamic-release-archive-op)
(asdf:find-system :clpm))
(uiop:copy-file (asdf:system-relative-pathname :clpm-asdf "License.rtf")
(merge-pathnames "License.rtf" staging-directory))
(with-open-file (s (merge-pathnames "clpm.wxs" staging-directory)
:if-exists :supersede :direction :output)
(format s "<?xml version='1.0'?>~%")
(s-xml:print-xml (build-wxs relative-files) :stream s :pretty t))
(uiop:with-current-directory (staging-directory)
(let* ((wix-base (uiop:parse-native-namestring (uiop:getenv "WIX") :ensure-directory t))
(candle (uiop:native-namestring (merge-pathnames "bin/candle.exe" wix-base)))
(light (uiop:native-namestring (merge-pathnames "bin/light.exe" wix-base)))
(extension (uiop:native-namestring (merge-pathnames "bin/WixUIExtension.dll" wix-base)))
(msi (asdf:system-relative-pathname :clpm-asdf
(uiop:strcat "releases/dynamic/"
"clpm-" (clpm-asdf::clpm-version)
"-windows-amd64.msi"))))
(uiop:run-program `(,candle "clpm.wxs")
:output :interactive
:error-output :interactive)
(uiop:run-program `(,light "clpm.wixobj" "-ext" ,extension "-cultures:en-us" "-out" "clpm.msi")
:output :interactive
:error-output :interactive)
(uiop:copy-file (merge-pathnames "clpm.msi" staging-directory)
msi)))))
(make-msi)
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment