instow

:)
git clone https://git.sr.ht/~ashymad/instow
Log | Files | Refs | LICENSE

main.janet (13146B)

      1 (import ./libc)
      2 (import ./file)
      3 (import ./tools)
      4 (import ./utils)
      5 (import ./native/nftw)
      6 
      7 (def columns ((libc/ioctl 1 :TIOCGWINSZ) 1))
      8 (def tty? (= (libc/isatty 1) 1))
      9 
     10 (def spinner "⠋⠙⠹⠸⠼⠴⠦⠧⠇⠏")
     11 (var spin (string/slice spinner 0 3))
     12 
     13 (defn rotate [spin_]
     14   (utils/rotate spin_ spinner 3))
     15 
     16 (defn message [state line log_file]
     17   (file/write log_file line "\n")
     18   (if tty?
     19     (do
     20       (def pre (string/format "\x1b[2K{%s}⸉%s⸊→" state spin))
     21       (prinf "%s%s\r" pre (string/slice line 0 (max 0 (min (- columns (length pre)) (length line)))))
     22       (flush))
     23     (printf "{%s}→%s" state line)))
     24 
     25 (defn prinfer [state log_file pipe]
     26   (def buf @"")
     27   (while (ev/read pipe 1024 buf)
     28     (def lines (string/split "\n" buf))
     29     (def len (length lines))
     30     (if (> len 1)
     31       (loop [[idx line] :pairs lines]
     32         (if (< idx (- len 1))
     33           (message state line log_file)
     34           (do
     35             (buffer/clear buf)
     36             (buffer/push-string buf line)))))))
     37 
     38 (defmacro errexit [msg]
     39   ~(do
     40      (set errormsg ,msg)
     41      (set state :error)))
     42 
     43 (defn procout [& args]
     44   (def proc (os/spawn args :px {:out :pipe}))
     45   (def buf @"")
     46   (ev/gather
     47     (ev/read (proc :out) :all buf)
     48     (os/proc-wait proc))
     49   (os/proc-close proc)
     50   buf)
     51 
     52 (defn runp [state env & args]
     53   (def log_file (file/open "./instow.log" :a))
     54   (file/write log_file (string "RUN: '" (string/join args "' '") "'\n"))
     55   (def proc (os/spawn args :e env))
     56   (ev/gather
     57     (prinfer state log_file (proc :out))
     58     (prinfer state log_file (proc :err))
     59     (os/proc-wait proc)
     60     (while (and tty? (nil? (get proc :return-code)))
     61       (ev/sleep 0.2) 
     62       (set spin (rotate spin))
     63       (prinf "{%s}⸉%s⸊\r" state spin)
     64       (flush)))
     65   (def code (get proc :return-code))
     66   (os/proc-close proc)
     67   (file/close log_file)
     68   code)
     69 
     70 (defmacro checkrun [newstate cmd & args]
     71   (with-syms [$ret $cmd]
     72     ~(utils/letsome ,$cmd (tools/gettool ,cmd)
     73       (let [,$ret (runp state env ,$cmd ,;args)]
     74         (if (= ,$ret 0)
     75           (set state ,newstate)
     76           (errexit (string/format "Command '%s' failed with code: %d" ,$cmd ,$ret))))
     77       (errexit (string/format "Unable to find the tool '%s'" ,cmd)))))
     78 
     79 (defn path/join [& args]
     80   (string/join [;args] "/"))
     81 
     82 (defn stropt [a b]
     83   (string/join [a b] "="))
     84 
     85 (defn main [& args]
     86     (def home (os/getenv "HOME"))
     87     (def target (path/join home ".usr" "local"))
     88     (def bindir (path/join target "bin"))
     89     (def mandir (path/join target "share" "man"))
     90     (def headerdir (path/join target "include"))
     91     (def libdir (path/join target "lib"))
     92     (def triplet (string/slice (procout "gcc" "-dumpmachine") 0 -2))
     93     (def syslibdir (path/join libdir triplet))
     94     (def stowdir (path/join target "stow"))
     95     (def srcdir (string/slice (procout "git" "rev-parse" "--show-toplevel") 0 -2))
     96     (def srcsubdir (os/cwd))
     97     (def pkg (libc/basename srcdir))
     98     (def pkgdir (path/join stowdir pkg))
     99     (def destdir (libc/mkdtemp "/tmp/instow.XXXXXX"))
    100 
    101     (def env (os/environ))
    102     (merge-into env {:err :pipe
    103                      :out :pipe
    104                      "PATH" (string/join [(os/getenv "PATH") bindir] ":")
    105                      "PKG_CONFIG_PATH" (string/join
    106                                          [(path/join libdir "pkgconfig")
    107                                           (path/join syslibdir "pkgconfig")] ":")
    108                      "CFLAGS" (string/join
    109                                 [(get env "CFLAGS" "")
    110                                  (stropt "--include-directory-after" headerdir)
    111                                  (stropt "-Wl,-rpath" libdir)
    112                                  (stropt "-Wl,-rpath" syslibdir)
    113                                  (string "-L" libdir)
    114                                  (string "-L" syslibdir)
    115                                  "-Wno-unused-command-line-argument"] " ")
    116                      "CXXFLAGS" (string/join
    117                                   [(get env "CXXFLAGS" "")
    118                                    (stropt "--include-directory-after" headerdir)
    119                                    (stropt "-Wl,-rpath" libdir)
    120                                    (stropt "-Wl,-rpath" syslibdir)
    121                                    (string "-L" libdir)
    122                                    (string "-L" syslibdir)
    123                                    "-Wno-unused-command-line-argument"] " ")
    124                      "RUSTFLAGS" (string/join
    125                                    ["-C" (string "link-args=-Wl,-rpath," libdir)
    126                                     "-C" (string "link-args=-Wl,-rpath," syslibdir)] " ")
    127                      "PERL5LIB" (path/join libdir "perl5")
    128                      "GOPATH" destdir})
    129 
    130     (var ret 0)
    131     (var state (if-let [st (get args 1)] (keyword st) :init))
    132     (var errormsg "Unknown")
    133     (var prefix target)
    134     (var builddir ".")
    135 
    136     (if (file/file-exists? "./instow.log") (os/rm "./instow.log"))
    137 
    138     (while (not= state :exit)
    139       (let [log_file (file/open "./instow.log" :a)]
    140         (file/write log_file (string/join ["STATE:" state "\n"] " "))
    141         (file/close log_file))
    142       (case state
    143         :init
    144         (cond
    145           (file/file-exists? "configure") (set state :conf/configure)
    146           (file/file-exists? "Makefile") (set state :build/make)
    147           (file/file-exists? "go.mod") (set state :build/go)
    148           (file/file-exists? "Cargo.toml") (set state :build/cargo)
    149           (or (file/file-exists? "setup.py")
    150               (file/file-exists? "pyproject.toml")) (set state :build/pip)
    151           (file/file-exists? "project.janet") (set state :build/jpm)
    152           (utils/some? (libc/glob "*.pro")) (set state :conf/qmake)
    153           (file/file-exists? "CMakeLists.txt") (set state :conf/cmake)
    154           (file/file-exists? "autogen.sh") (set state :conf/autogen)
    155           (file/file-exists? "configure.ac") (set state :conf/autoreconf)
    156           (file/file-exists? "meson.build") (set state :conf/meson)
    157           (file/file-exists? "wscript") (set state :conf/waf)
    158           (file/file-exists? "package.json") (set state :conf/npm)
    159           (errexit "Unable to auto-detect the build system"))
    160 
    161         :conf/autoreconf
    162         (checkrun :conf/configure :autoreconf "-vi") 
    163 
    164         :conf/autogen
    165         (checkrun :conf/configure :autogen) 
    166 
    167         :conf/configure
    168         (checkrun :build/make :configure (stropt "--prefix" prefix))
    169 
    170         :conf/waf
    171         (do
    172           (set builddir "build")
    173           (checkrun :build/waf :waf "configure" "-o" builddir "--prefix" prefix))
    174 
    175         :conf/qmake
    176         (do
    177           (set builddir "build")
    178           (set prefix "/usr/")
    179           (checkrun :build/make
    180                     :qmake
    181                     (stropt "QMAKE_CXXFLAGS" (env "CXXFLAGS"))
    182                     (stropt "QMAKE_CFLAGS" (env "CFLAGS"))
    183                     (string "QMAKE_LIBDIR+=" libdir " " syslibdir)
    184                     (string "QMAKE_RPATHDIR+=" libdir " " syslibdir)
    185                     "-o" (path/join builddir "Makefile")
    186                     ))
    187 
    188         :conf/meson
    189         (do
    190           (set builddir "build")
    191           (checkrun :build/meson :meson "setup" builddir (stropt "--prefix" prefix)))
    192 
    193         :conf/cmake
    194         (do
    195           (set builddir "build")
    196           (checkrun :build/make :cmake "-B" builddir "-S" "." (stropt "-DCMAKE_INSTALL_PREFIX" prefix)))
    197 
    198         :conf/npm
    199         (checkrun :build/npm
    200                   :npm "install"
    201                   "--cache" (path/join builddir ".npm")
    202                   "--loglevel" "verbose"
    203                   "--include-workspace-root")
    204 
    205         :build/make
    206         (checkrun :install/make
    207                   :make
    208                   "-C" builddir
    209                   (string/format "-j%d" (libc/get_nprocs))
    210                   ;(if-let [cc (os/getenv "CC")] [(stropt "CC" cc)] [])
    211                   ;(if-let[cxx (os/getenv "CXX")] [(stropt "CXX" cxx)] [])
    212                   "--"
    213                   ;(if-let [m (os/getenv "MAKETARGETS")] (string/split " " m) []))
    214 
    215         :build/go
    216         (checkrun :install/go :go "build" "-v")
    217 
    218         :build/waf
    219         (checkrun :install/waf :waf "build" "-o" builddir)
    220 
    221         :build/cargo
    222         (do
    223           (os/cd srcdir)
    224           (checkrun :install/cargo :cargo "build" "--locked" "--release")
    225           (os/cd srcsubdir)
    226           (if (file/file-exists? "install.yml") (set state :install/rinstall)))
    227 
    228         :build/pip
    229         (do
    230           (set builddir "build")
    231           (checkrun :install/pip :pip "wheel" "." "-w" builddir "--no-build-isolation" "--no-deps"))
    232 
    233 
    234         :build/meson
    235         (checkrun :install/meson :meson "compile" "-C" builddir)
    236 
    237         :build/npm
    238         (checkrun :install/npm
    239                   :npm "run" "build"
    240                   "--cache" (path/join builddir ".npm")
    241                   "--loglevel" "verbose"
    242                   "--include-workspace-root")
    243 
    244         :build/jpm
    245         (checkrun :install/jpm :jpm "build")
    246 
    247         :install/make
    248         (checkrun :post/detectprefix
    249                   :make
    250                   "-C" builddir
    251                   "install"
    252                   ;(if-let [mf (env "MAKEFLAGS")] (string/split " " mf) [])
    253                   (stropt "PREFIX" prefix)
    254                   (stropt "prefix" prefix)
    255                   (stropt "CMAKE_INSTALL_PREFIX" prefix)
    256                   (stropt "DESTDIR" destdir)
    257                   (stropt "INSTALL_ROOT" destdir))
    258 
    259         :install/meson
    260         (checkrun :move :meson "install" "-C" builddir (stropt "--destdir" destdir))
    261 
    262         :install/waf
    263         (checkrun :move :waf "install" "-o" builddir "--destdir" destdir)
    264 
    265         :install/go
    266         (do
    267           (set prefix "")
    268           (checkrun :install/go :go "install" "-v")
    269           (checkrun :move :go "clean" "-modcache"))
    270 
    271         :install/npm
    272         (do
    273           (set prefix "")
    274           (checkrun :move :npm "install"
    275                     "-g"
    276                     "--install-links"
    277                     "--cache" (path/join builddir ".npm")
    278                     "--prefix" destdir))
    279 
    280         :install/jpm
    281         (checkrun :move
    282                   :jpm
    283                   (stropt "--dest-dir" destdir)
    284                   (stropt "--binpath" bindir)
    285                   (stropt "--manpath" (path/join mandir "man1"))
    286                   (stropt "--modpath" (path/join libdir "janet"))
    287                   (stropt "--libpath" libdir)
    288                   (stropt "--headerpath" (path/join headerdir "janet"))
    289                   "install")
    290         :install/rinstall
    291         (checkrun :move :rinstall "install" "-y" "--destdir" destdir "--packaging" "--prefix" prefix)
    292 
    293         :install/cargo
    294         (do
    295           (set prefix "")
    296           (os/cd srcdir)
    297           (checkrun :move :cargo "install" "--offline" "--frozen" "--no-track" "--root" destdir "--path" srcsubdir)
    298           (os/cd srcsubdir))
    299 
    300         :install/pip
    301         (utils/letsome wheels (libc/glob (path/join builddir "*.whl"))
    302            (checkrun :post/detectprefix
    303                      :pip "install"
    304                      (stropt "--root" destdir)
    305                      (stropt "--prefix" prefix)
    306                      "--no-build-isolation"
    307                      "--no-deps"
    308                      "--force-reinstall"
    309                      ;wheels)
    310            (errexit "No wheels present"))
    311 
    312         :post/detectprefix
    313         (do
    314           (if (file/dir-exists? (path/join destdir prefix "local")) (set prefix (path/join prefix "local")))
    315           (set state :move))
    316 
    317         :move
    318         (let [log_file (file/open "./instow.log" :a)
    319               installdir (path/join destdir prefix)]
    320           (if (file/dir-exists? installdir)
    321             (do
    322               (if (file/dir-exists? pkgdir)
    323                 (do
    324                   (checkrun :stow :stow "-v" "-d" stowdir "-t" target "-D" pkg)
    325                   (file/rmrf pkgdir)))
    326               (set state (if (nil? (libc/glob (path/join installdir "lib" "*.so.*"))) :stow :ldconfig))
    327               (if (not= state :error)
    328                 (nftw/nftw installdir
    329                            (fn [file stat ftype info]
    330                              (if (or (= ftype :f) (= ftype :sl))
    331                                (do
    332                                  (def dst (path/join pkgdir (string/slice file (length installdir))))
    333                                  (message state (string/format "MV: %s => %s" file dst) log_file)
    334                                  (file/move-file file dst))) 0) 1024 :phys)))
    335             (errexit "The destination directory doesn't contain the prefix"))
    336           (file/close log_file))
    337 
    338         :ldconfig
    339         (checkrun :stow :ldconfig "-vNn" (path/join pkgdir "lib"))
    340 
    341         :stow
    342         (checkrun :done :stow "-v" "-d" stowdir "-t" target pkg)
    343 
    344         :error
    345         (do
    346           (set ret 1)
    347           (printf "\x1b[2K{%s}⸉!⸊→%s" state errormsg)
    348           (set state :cleanup))
    349 
    350         :done
    351         (do
    352           (printf "\x1b[2K{%s}⸉x⸊→Success" state)
    353           (set state :cleanup))
    354 
    355         :cleanup
    356         (do
    357           (file/rmrf (string/join [destdir]))
    358           (set state :exit))
    359         
    360         #default
    361         (errexit (string "Unknown state: " state))))
    362 ret
    363 )