-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathLakefile
160 lines (147 loc) · 6.16 KB
/
Lakefile
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
#|-*- mode:lisp -*-|#
(load "roswell.github.utils.asd")
(ql:quickload '(:roswell.github.utils #-lparallel :cl-syntax :jonathan) :silent t)
(ros:include "util")
(in-package :cl-user)
(defpackage :lake.user
(:use :cl #+lparallel :lake :cl-syntax :roswell.github.utils)
#+lparallel
(:shadowing-import-from :lake
:directory))
(in-package :lake.user)
(use-syntax :interpol)
(defvar *ci-supported*
'("x86-64-linux-binary.tar.bz2"
"x86-linux-binary.tar.bz2"
"x86-64-darwin-binary.tar.bz2"
"x86-darwin-binary.tar.bz2"
"arm64-linux-binary.tar.bz2"))
#-lparallel ;; missing functions from lake
(progn
(defmacro task (name ign &body body)
(declare (ignore ign))
`(defun ,(read-from-string name) ()
,@body))
(defgeneric sh (command &key echo)
(:documentation
"Takes a string or list of strings and runs it from a shell."))
(defmethod sh ((command string) &key (echo t))
(when echo
(format *error-output* "sh:~A~%" command)
(force-output t))
(multiple-value-bind (output error-output return-status)
(uiop:run-program command :input :interactive
:output :interactive
:error-output :interactive
:ignore-error-status t)
(declare (ignore output error-output))
(unless (zerop return-status)
(error "Command ~S exited with error code ~A." command return-status))))
(defmethod sh ((command list) &key echo)
(let ((command1 (format nil "~{~A~^ ~}" command)))
(sh command1 :echo echo))))
(defun output-html (in out &optional version)
(let ((p (plump:parse (pathname in)))
(uri (format nil "https://github.com/~A/~A/releases/download/" *user* *repo*)))
(with-open-file (o (pathname out) :direction :output)
(when version
(let ((tmp (format nil "~A~A/sbcl-~A-" uri version version)))
(mapc
(lambda (x)
(format o "<a href=~S></a>~%" (format nil "~A~A" tmp x)))
*ci-supported*)))
(mapc #'(lambda (x)
(let ((file (first (last (split-sequence:split-sequence #\/ (plump:get-attribute x "href"))))))
(format o "<a href=~S></a>~%" (concatenate 'string uri (second (split-sequence:split-sequence #\- file)) "/" file))))
(remove-if-not
#'(lambda (x)
(find (first (last (split-sequence:split-sequence #\.(plump:get-attribute x "href"))))
'("bz2" "msi") :test 'equal))
(plump:get-elements-by-tag-name p "a"))))))
(defun mirror-newest ()
(format t "mirror-newest~%")(force-output)
(dex:fetch "http://sbcl.org/platform-table.html" #P"sbcl-bin.html" :if-exists :supersede)
(sh "cat sbcl-bin.html| grep http|awk -F '\"' '{print $2}'|grep binary > uris")
(format t "fetching uris~%")(force-output)
(with-open-file (in "uris")
(loop with releases = (progn
(format t "fetching releases-list ~A ~A" *user* *repo*)(force-output)
(prog1 (releases-list *user* *repo*)
(format t " done~%")(force-output)))
for uri = (read-line in nil nil)
while uri
for path = (file-namestring (quri:uri-path (quri:uri uri)))
for *release* = (second (split-sequence:split-sequence #\- (pathname-name path)))
do (format t "~%~a " uri)
(force-output)
(cond ((find path (getf (find *release*
releases
:key (lambda (x) (getf x :|tag_name|))
:test 'equal) :|assets|)
:key (lambda (x) (getf x :|name|))
:test #'equal)
(format t "skip[exist]"))
((find-if (let ((y (ignore-errors
(subseq path
(1+ (position #\- path :start 5))))))
(lambda (x)
(equal x y)))
*ci-supported*)
(ensure-release-exists (second (split-sequence:split-sequence #\- (pathname-name path)))
:owner *user*
:repo *repo*)
(format t "skip[ci]"))
(t (fetch-upload path uri (second (split-sequence:split-sequence #\- (pathname-name path))))))
(force-output)))
(let ((path "sbcl-bin.html")
(out "mirror.html"))
(format t "~A ~%" (list path *release* *user* *repo* t))
(force-output)
(ignore-errors
(github path *release* *user* *repo* t))
(output-html path out)
(ignore-errors
(github out *release* *user* *repo* t))))
(defun env (name)
(let ((val (ros:getenv name)))
(unless (zerop (length val))
val)))
(defun version-target ()
(values (or (env "TRAVIS_TAG")
(env "APPVEYOR_REPO_TAG_NAME")
(env "VERSION")
(let ((branch (env "TRAVIS_BRANCH")))
(unless (equal "master" branch)
branch)))
(or (env "TARGET")
(roswell.util:uname-m))
(or (env "SUFFIX")
"")))
(task "default" ()
)
(task "mirror" ()
(let ((ver (version-target)))
(print (list *user* *repo* ver))
(mirror-newest)))
(task "upload-build-list" ()
(multiple-value-bind (ver) (version-target)
(when (and (not (zerop (length ver)))
(< (length ver) 20))
(let ((path "sbcl-bin.html")
(out "build.html"))
(dex:fetch "http://sbcl.org/platform-table.html"
#P"sbcl-bin.html" :if-exists :supersede)
(format t "~A ~%" (list path *release* *user* *repo* t))
(force-output)
(output-html path out ver)
(ignore-errors
(github out *release* *user* *repo* t))))))
#-lparallel
(unwind-protect
(let (method)
(and (setf method (ros:getenv "METHOD"))
(setf method (read-from-string method))
(fboundp method)
(funcall method)))
(unless (find-package :swank)
(uiop:quit)))