From b439fac7508cad6fa448dd30fc5e462e57e6d9a0 Mon Sep 17 00:00:00 2001 From: snmsts Date: Sun, 8 Sep 2024 17:45:22 +0900 Subject: [PATCH] delete web.ros to refer sbcl_bin --- Makefile | 13 ++- web.ros | 272 ------------------------------------------------------- 2 files changed, 8 insertions(+), 277 deletions(-) delete mode 100644 web.ros diff --git a/Makefile b/Makefile index 1e826e7..69a3adb 100644 --- a/Makefile +++ b/Makefile @@ -11,20 +11,23 @@ TSV_FILE=sbcl-bin_uri.tsv hash: git ls-remote --heads $(ORIGIN_URI) $(ORIGIN_REF) |sed -r "s/^([0-9a-fA-F]*).*/\1/" > hash -lasthash: +lasthash: web.ros curl -sSL -o lasthash $(GITHUB)/releases/download/$(LAST_VERSION)/hash -upload-hash: hash lasthash +upload-hash: hash lasthash web.ros diff -u hash lasthash || VERSION=$(VERSION) ros web.ros upload-hash -tsv: +tsv: web.ros TSV_FILE=$(TSV_FILE) ros web.ros tsv -upload-tsv: +upload-tsv: web.ros TSV_FILE=$(TSV_FILE) ros web.ros upload-tsv -version: +version: web.ros @echo $(LAST_VERSION) > version +web.ros: + curl -L -O https://raw.githubusercontent.com/roswell/sbcl_bin/master/web.ros + clean: rm -f hash lasthash diff --git a/web.ros b/web.ros deleted file mode 100644 index d3e7429..0000000 --- a/web.ros +++ /dev/null @@ -1,272 +0,0 @@ -#!/bin/sh -#|-*- mode:lisp -*-|# -#| -exec ros -Q -- $0 "$@" -|# -(progn ;;init forms - (ros:ensure-asdf) - (ignore-errors - (load "roswell.github.utils.asd")) - (ignore-errors - (ql:quickload '(:roswell.github.utils) :silent t)) - #+quicklisp(ql:quickload '(:dexador :jonathan) :silent t)) - -(defpackage :ros.script.web.3788143716 - (:use :cl)) -(in-package :ros.script.web.3788143716) - -(defvar *version* nil) - -(defun env (name) - (let ((val (ros:getenv name))) - (unless (zerop (length val)) - val))) - -(defun version-target (&key (target :compiler)) - (values (or *version* - (env "TRAVIS_TAG") - (env "APPVEYOR_REPO_TAG_NAME") - (let ((version (env "VERSION")) ) - (if (equal "99.99.99" version) - nil - version)) - (let ((branch (env "TRAVIS_BRANCH"))) - (unless (equal "master" branch) - branch)) - nil) - (let ((m (or (env "ARCH") - (roswell.util:uname-m)))) - (cond ((and (equal m "armhf") - (eql target :compiler)) - "arm") - ((and (not (eql target :compiler)) - (equal m "arm")) - "armhf") - (t m))) - (or (env "SUFFIX") - "") - (or (env "UNAME") - (roswell.util:uname)))) - -(defun account () - (values - (or (env "GH_USER") (symbol-value (uiop:safe-read-from-string "roswell.github.utils:*user*"))) - (or (env "GH_REPO") (symbol-value(uiop:safe-read-from-string "roswell.github.utils:*repo*"))))) - -(defun tsv-filename () - (or (env "TSV_FILE") - "sbcl-bin_uri.tsv")) - -(export - (defun upload (files &key (interactive t)) - (multiple-value-bind (version target suffix uname) - (version-target) - (multiple-value-bind (user repo) - (account) - (format t "version:~A target:~A suffix:~A uname:~A user:~A repo:~A ~%" version target suffix uname - user repo) - (when (or (not interactive) - (yes-or-no-p "upload files:~%~{~S~%~}~%~%OK?" files)) - (dolist (file files) - (loop repeat 10 - until (ignore-errors - (uiop:symbol-call :roswell.github.utils :github - file version user repo t)) - do (sleep 3)))))))) - -(export - (defun upload-archive (args) - (declare (ignore args)) - (multiple-value-bind (version target suffix uname) - (version-target :target :archive) - (let* ((release (and version (< (length version) 20))) - (path (print (format nil "sbcl-~A-~A-~A~A-binary" - version - target - uname - suffix)))) - (when release - (ql:quickload :sb-md5) - (let ((file (or (env "FILE") - (format nil (if (equal uname "windows") "~A.msi" "~A.tar.bz2") - path)))) - (cond ((probe-file file) - (format t "~(~{~2,'0X~}~)" - (map 'list #'identity (funcall (read-from-string "sb-md5:md5sum-file") file))) - (multiple-value-bind (user repo) - (account) - (uiop:symbol-call :roswell.github.utils :github - file version user repo nil))) - (t - (format t "file not found:~A~%" file) - (uiop:quit 1))))))))) - -(defun releases () - (multiple-value-bind (user repo) - (account) - (jojo:parse (dex:get (format nil "https://api.github.com/repos/~A/~A/releases" user repo))))) - -(defun latest-relase () - (multiple-value-bind (user repo) - (account) - (jojo:parse (dex:get (format nil "https://api.github.com/repos/~A/~A/releases/latest" user repo))))) - -(defun release-uris (&optional (release (latest-relase))) - (loop for asset in (getf release :|assets|) - when (find (getf asset :|content_type|) '("application/x-bzip2" "application/x-msi") :test 'equal) - collect (getf asset :|browser_download_url|))) - -(defun release-tag_name (&optional (release (latest-relase))) - (getf release :|tag_name|)) - -(defun tsv-uri (&optional (release (latest-relase))) - (multiple-value-bind (user repo) - (account) - (format nil "https://github.com/~A/~A/releases/download/~A/~A" - user repo - (release-tag_name release) - (tsv-filename)))) - -(defun parse-tsv (string) - (mapcar (lambda (x) (uiop:split-string x :separator '(#\tab))) - (uiop:split-string string :separator '(#\lf)))) - -(defun save-tsv (file tsv) - (with-open-file (out file :direction :output :if-exists :supersede) - (format out "~{~{~A~^ ~}~^~%~}" tsv))) - -(defun modify-tsv (tsv release) - (loop with tag-name = (release-tag_name release) - with comp = (lambda (x) (ignore-errors (aref (nth-value 1 (ppcre:scan-to-strings "[a-z]*-[^-]*-([^/]*)$" x)) 0))) - for uri in (remove-if-not (lambda (x) (ppcre:scan "binary" x)) - (release-uris release)) - for found = (find uri tsv :test #'(lambda (x y) - (equal (funcall comp x) - (funcall comp (fifth y))))) - do (if found - (setf (fifth found) uri - (third found) tag-name) - (format t "unlisted uri: ~S~%" uri))) - tsv) - -(defun updated-tsv () - (let* ((releases (releases)) - (tsv (or (ignore-errors (parse-tsv (dex:get (print (tsv-uri (second releases))) :force-string t))) - ;; download second new release's tsv or upload current tsv. - (let ((*version* (release-tag_name (second releases))) - (result (parse-tsv (tsv-get "files")))) - (print *version*) - (save-tsv (tsv-filename) result) - (upload-tsv nil) - result)))) - (mapc (lambda (x) (modify-tsv tsv x)) (reverse releases)) - (setf (rest tsv) (sort (rest tsv) (complement #'uiop/version:version<) :key #'third)) - tsv)) - -(export - (defun tsv (args) - (declare (ignore args)) - (save-tsv (tsv-filename) (updated-tsv)))) - -(defun tsv-get (&optional (version "files")) - (multiple-value-bind (user repo) - (account) - (dex:get (format nil "https://github.com/~A/~A/releases/download/~A/~A" - user repo version (tsv-filename)) - :force-string t))) - -(export - (defun get-tsv (args) - (declare (ignore args)) - (multiple-value-bind (version) - (version-target :target :archive) - (with-open-file (o (tsv-filename) :direction :output :if-exists :supersede) - (format o "~A" (tsv-get (or version "files"))))))) - -(export - (defun upload-tsv (args) - (declare (ignore args)) - (multiple-value-bind (version) - (version-target :target :archive) - (let ((path (tsv-filename))) - (progn - (ql:quickload :sb-md5) - (cond ((probe-file path) - (let* ((version (or version "files")) - (new (format nil "~(~{~2,'0X~}~)" - (map 'list #'identity (funcall (read-from-string "sb-md5:md5sum-file") path)))) - (old (ignore-errors - (format nil "~(~{~2,'0X~}~)" - (map 'list #'identity (funcall (read-from-string "sb-md5:md5sum-string") - (tsv-get version))))))) - (format t "new:~A~%old:~A~%" new old) - (multiple-value-bind (user repo) - (account) - (unless (equal new old) - (uiop:symbol-call :roswell.github.utils :github - path version user repo t))))) - (t - (format t "file not found:~A~%" path) - (uiop:quit 1)))))))) - -(export - (defun upload-hash (args) - (declare (ignore args)) - (multiple-value-bind (version) - (version-target :target :archive) - (let ((path "hash")) - (progn - (cond ((probe-file path) - (multiple-value-bind (user repo) - (account) - (uiop:symbol-call :roswell.github.utils - :ensure-release-exists - version - :owner user - :repo repo) - (uiop:symbol-call :roswell.github.utils :github - path version user repo nil))) - (t - (format t "file not found:~A~%" path) - (uiop:quit 1)))))))) - -(export - (defun latests (args) - (declare (ignore args)) - (format t "~{~A~%~}" (release-uris)))) - -(export - (defun version (args) - (declare (ignore args)) - (format t "~A~%" (release-tag_name)))) - -(export - (defun os (args) - (declare (ignore args)) - (format t "~A~%" (roswell.util:uname)))) - -(defvar *sh* nil) -(defvar *var* nil) - -(defun optp (arg) - (when (and arg - (loop for i across arg - repeat 2 - always (eql i #\-))) - (subseq arg 2))) - -(defun main (&rest argv) - (loop - for opt = (optp (first argv)) - while opt - when opt - do (setf *var* (acons opt (second argv) *var*) - argv (cdr argv)) - do (setf argv (cdr argv)) - finally (let ((symbol (read-from-string (if argv - (first argv) - "default")))) - (when (eql (nth-value 1 (find-symbol (string symbol))) :external) - (funcall symbol (rest argv))))) - (format t "~{~A~%~}" (reverse *sh*))) -;;; vim: set ft=lisp lisp: