mirror of
https://github.com/roswell/roswell.git
synced 2026-09-10 07:16:17 -04:00
140 lines
5 KiB
Common Lisp
Executable file
140 lines
5 KiB
Common Lisp
Executable file
#!/bin/sh
|
|
#|-*- mode:lisp -*-|#
|
|
#|
|
|
exec ros -Q -- $0 "$@"
|
|
|#
|
|
(ql:quickload '(:plump :dexador :cl-ppcre))
|
|
|
|
(defvar *base-html* "https://sourceforge.net")
|
|
(defvar *root-html* "https://sourceforge.net/projects/sbcl/files/sbcl/")
|
|
|
|
(defvar *supported-table*
|
|
'((:linux (:x86 :x86-64 :powerpc :sparc :alpha :mips :mipsel :armel :armhf))
|
|
(:darwin (:x86 :x86-64 :powerpc))
|
|
(:solaris (:x86 :x86-64 :sparc))
|
|
(:freebsd (:x86 :x86-64))
|
|
(:netbsd (:x86 :x86-64 :powerpc))
|
|
(:openbsd (:x86 :x86-64 :powerpc))
|
|
(:dragonfly ( :x86-64))
|
|
(:debian-kfreebsd (:x86 :x86-64))
|
|
(:windows (:x86 :x86-64))))
|
|
|
|
(defun table2pair (&optional (table *supported-table*))
|
|
(loop :for (os cpus) :in table
|
|
:append (loop :for cpu :in cpus
|
|
:collect (cons os cpu))))
|
|
|
|
(let (result)
|
|
(defun cpulist (&optional (table *supported-table*))
|
|
(unless result
|
|
(loop :with r
|
|
:for (os cpus) :in table
|
|
:do (loop :for cpu :in cpus
|
|
:do (pushnew cpu r))
|
|
:finally (setq result r)))
|
|
result))
|
|
|
|
(defun valid-cpu (cpu)
|
|
(find cpu (cpulist) :test 'string-equal))
|
|
|
|
(let (result)
|
|
(defun oslist (&optional (table *supported-table*))
|
|
(unless result
|
|
(setq result (mapcar 'car table)))
|
|
result))
|
|
|
|
(defun valid-os (os)
|
|
(or (find-if (lambda (_) (string-equal _ os :end2 (min (length (string _))
|
|
(length (string os)))))
|
|
(oslist))
|
|
(and (equal os "debian") ;; dirty...
|
|
:debian-kfreebsd)))
|
|
|
|
(defun version-list (&optional (html *root-html*))
|
|
(let ((html (plump:get-element-by-id (plump:parse (dex:get html)) "files_list"))
|
|
result)
|
|
(labels
|
|
((f (x depth)
|
|
(let ((ret
|
|
(loop :for i :across (plump:children x)
|
|
:unless (or
|
|
(typep i 'plump-dom:doctype)
|
|
(typep i 'plump-dom:comment)
|
|
(typep i 'plump-dom:fulltext-element)
|
|
(typep i 'plump-dom:text-node))
|
|
:collect (f i (1+ depth)))))
|
|
(when (equal (or ret (plump:tag-name x)) "a")
|
|
(push (plump:attribute x "href") result)))))
|
|
(f html 0)
|
|
(reverse result))))
|
|
|
|
(defun list-files (&optional (elt "/projects/sbcl/files/sbcl/1.2.13/"))
|
|
(let((html (plump:get-element-by-id
|
|
(plump:parse (dex:get (format nil "~A~A" *base-html* elt)))
|
|
"files_list"))
|
|
result)
|
|
(labels
|
|
((f (x depth)
|
|
(let ((ret (loop :for i :across (plump:children x)
|
|
:unless (or
|
|
(typep i 'plump-dom:doctype)
|
|
(typep i 'plump-dom:comment)
|
|
(typep i 'plump-dom:fulltext-element)
|
|
(typep i 'plump-dom:text-node))
|
|
:collect (f i (1+ depth)))))
|
|
(when (equal (or ret (plump:tag-name x)) "a")
|
|
(push (plump:attribute x "href") result)))))
|
|
(f html 0)
|
|
(reverse result))))
|
|
|
|
(defun information-from-sourceforge.net (uri)
|
|
(let ((result (rest (split-sequence:split-sequence #\- (cl-ppcre:scan-to-strings "/sbcl-[^/]*" uri)))))
|
|
(when result
|
|
(when (and (equal (second result) "x86")
|
|
(equal (third result) "64"))
|
|
(setq result `(,(first result) "x86-64" ,@(nthcdr 3 result))))
|
|
(setq result (if (and (valid-cpu (second result))
|
|
(valid-os (third result)))
|
|
`(,(first result) (,(valid-os (third result)) . ,(valid-cpu (second result)))
|
|
,(cl-ppcre:scan-to-strings ".*\\.[^/]*" uri))
|
|
nil))
|
|
result)))
|
|
;; (information-from-sourceforge.net "http://sourceforge.net/projects/sbcl/files/sbcl/1.2.13/sbcl-1.2.13-x86-windows-binary.msi/download")
|
|
|
|
(defun collect-uri ()
|
|
(loop
|
|
:with a := (table2pair)
|
|
:with result
|
|
:for version :in (version-list)
|
|
:while a
|
|
:do (list a result)
|
|
(loop :for j :in (list-files (print version))
|
|
:for i := (information-from-sourceforge.net j)
|
|
:when i
|
|
:do (when (find (second i) a :test 'equalp)
|
|
(print (cons :found (second i)))
|
|
(push i result)
|
|
(setq a (remove (second i) a :test 'equalp))))
|
|
:finally (return result)))
|
|
|
|
(defvar *html-head* "<!DOCTYPE html>
|
|
<html>
|
|
<head></head>
|
|
<body>")
|
|
|
|
(defvar *html-foot* "</body>
|
|
</html>
|
|
")
|
|
|
|
(defun html-to-file (file list)
|
|
(with-open-file (o file :direction :output :if-exists :supersede :if-does-not-exist :create)
|
|
(format o "~A~%" *html-head*)
|
|
(loop :for line :in (reverse list)
|
|
:do (format o "<a href=\"~A\">~A ~A</a>~%" (third line)
|
|
(car(second line)) (cdr(second line))))
|
|
(format o "~A~%" *html-foot*)))
|
|
|
|
(defun main (&rest argv)
|
|
(declare (ignorable argv))
|
|
(html-to-file (first argv) (collect-uri)))
|