instow

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

main.janet (13508B)

      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 (if (= srcsubdir srcdir)
     98                (libc/basename srcdir)
     99                (do
    100                  (os/cd srcdir)
    101                  (string/join [(libc/basename srcdir)
    102                                (libc/basename srcsubdir)] "::"))))
    103     (def pkgdir (path/join stowdir pkg))
    104     (def destdir (libc/mkdtemp "/tmp/instow.XXXXXX"))
    105 
    106     (def env (os/environ))
    107     (merge-into env {:err :pipe
    108                      :out :pipe
    109                      "PATH" (string/join [(os/getenv "PATH") bindir] ":")
    110                      "PKG_CONFIG_PATH" (string/join
    111                                          [(path/join libdir "pkgconfig")
    112                                           (path/join syslibdir "pkgconfig")] ":")
    113                      "CFLAGS" (string/join
    114                                 [(get env "CFLAGS" "")
    115                                  (stropt "--include-directory-after" headerdir)
    116                                  (stropt "-Wl,-rpath" libdir)
    117                                  (stropt "-Wl,-rpath" syslibdir)
    118                                  (string "-L" libdir)
    119                                  (string "-L" syslibdir)
    120                                  "-Wno-unused-command-line-argument"] " ")
    121                      "CXXFLAGS" (string/join
    122                                   [(get env "CXXFLAGS" "")
    123                                    (stropt "--include-directory-after" headerdir)
    124                                    (stropt "-Wl,-rpath" libdir)
    125                                    (stropt "-Wl,-rpath" syslibdir)
    126                                    (string "-L" libdir)
    127                                    (string "-L" syslibdir)
    128                                    "-Wno-unused-command-line-argument"] " ")
    129                      "RUSTFLAGS" (string/join
    130                                    ["-C" (string "link-args=-Wl,-rpath," libdir)
    131                                     "-C" (string "link-args=-Wl,-rpath," syslibdir)] " ")
    132                      "PERL5LIB" (path/join libdir "perl5")
    133                      "GOPATH" destdir})
    134 
    135     (var ret 0)
    136     (var state (if-let [st (get args 1)] (keyword st) :init))
    137     (var errormsg "Unknown")
    138     (var prefix target)
    139     (var builddir ".")
    140 
    141     (if (file/file-exists? "./instow.log") (os/rm "./instow.log"))
    142 
    143     (while (not= state :exit)
    144       (let [log_file (file/open "./instow.log" :a)]
    145         (file/write log_file (string/join ["STATE:" state "\n"] " "))
    146         (file/close log_file))
    147       (case state
    148         :init
    149         (cond
    150           (file/file-exists? "configure") (set state :conf/configure)
    151           (file/file-exists? "Makefile") (set state :build/make)
    152           (file/file-exists? "go.mod") (set state :build/go)
    153           (file/file-exists? "Cargo.toml") (set state :build/cargo)
    154           (or (file/file-exists? "setup.py")
    155               (file/file-exists? "pyproject.toml")) (set state :build/pip)
    156           (file/file-exists? "Build.PL") (set state :build/perl)
    157           (file/file-exists? "project.janet") (set state :build/jpm)
    158           (utils/some? (libc/glob "*.pro")) (set state :conf/qmake)
    159           (file/file-exists? "CMakeLists.txt") (set state :conf/cmake)
    160           (file/file-exists? "autogen.sh") (set state :conf/autogen)
    161           (file/file-exists? "configure.ac") (set state :conf/autoreconf)
    162           (file/file-exists? "meson.build") (set state :conf/meson)
    163           (file/file-exists? "wscript") (set state :conf/waf)
    164           (file/file-exists? "package.json") (set state :conf/npm)
    165           (errexit "Unable to auto-detect the build system"))
    166 
    167         :conf/autoreconf
    168         (checkrun :conf/configure :autoreconf "-vi") 
    169 
    170         :conf/autogen
    171         (checkrun :conf/configure :autogen) 
    172 
    173         :conf/configure
    174         (checkrun :build/make :configure (stropt "--prefix" prefix))
    175 
    176         :conf/waf
    177         (do
    178           (set builddir "build")
    179           (checkrun :build/waf :waf "configure" "-o" builddir "--prefix" prefix))
    180 
    181         :conf/qmake
    182         (do
    183           (set builddir "build")
    184           (set prefix "/usr/")
    185           (checkrun :build/make
    186                     :qmake
    187                     (stropt "QMAKE_CXXFLAGS" (env "CXXFLAGS"))
    188                     (stropt "QMAKE_CFLAGS" (env "CFLAGS"))
    189                     (string "QMAKE_LIBDIR+=" libdir " " syslibdir)
    190                     (string "QMAKE_RPATHDIR+=" libdir " " syslibdir)
    191                     "-o" (path/join builddir "Makefile")
    192                     ))
    193 
    194         :conf/meson
    195         (do
    196           (set builddir "build")
    197           (checkrun :build/meson :meson "setup" builddir (stropt "--prefix" prefix)))
    198 
    199         :conf/cmake
    200         (do
    201           (set builddir "build")
    202           (checkrun :build/make :cmake "-B" builddir "-S" "." (stropt "-DCMAKE_INSTALL_PREFIX" prefix)))
    203 
    204         :conf/npm
    205         (checkrun :build/npm
    206                   :npm "install"
    207                   "--cache" (path/join builddir ".npm")
    208                   "--loglevel" "verbose"
    209                   "--include-workspace-root")
    210 
    211         :build/make
    212         (checkrun :install/make
    213                   :make
    214                   "-C" builddir
    215                   (string/format "-j%d" (libc/get_nprocs))
    216                   ;(if-let [cc (os/getenv "CC")] [(stropt "CC" cc)] [])
    217                   ;(if-let[cxx (os/getenv "CXX")] [(stropt "CXX" cxx)] [])
    218                   "--"
    219                   ;(if-let [m (os/getenv "MAKETARGETS")] (string/split " " m) []))
    220 
    221         :build/go
    222         (checkrun :install/go :go "build" "-v")
    223 
    224         :build/perl
    225         (checkrun :install/perl :perl "./Build.PL")
    226 
    227         :build/waf
    228         (checkrun :install/waf :waf "build" "-o" builddir)
    229 
    230         :build/cargo
    231         (do
    232           (checkrun :install/cargo :cargo "build" "--locked" "--release")
    233           (if (file/file-exists? "install.yml") (set state :install/rinstall)))
    234 
    235         :build/pip
    236         (do
    237           (set builddir "build")
    238           (checkrun :install/pip :pip "wheel" "." "-w" builddir "--no-build-isolation" "--no-deps"))
    239 
    240 
    241         :build/meson
    242         (checkrun :install/meson :meson "compile" "-C" builddir)
    243 
    244         :build/npm
    245         (checkrun :install/npm
    246                   :npm "run" "build"
    247                   "--cache" (path/join builddir ".npm")
    248                   "--loglevel" "verbose"
    249                   "--include-workspace-root")
    250 
    251         :build/jpm
    252         (checkrun :install/jpm :jpm "build")
    253 
    254         :install/make
    255         (checkrun :post/detectprefix
    256                   :make
    257                   "-C" builddir
    258                   "install"
    259                   ;(if-let [mf (env "MAKEFLAGS")] (string/split " " mf) [])
    260                   (stropt "PREFIX" prefix)
    261                   (stropt "prefix" prefix)
    262                   (stropt "CMAKE_INSTALL_PREFIX" prefix)
    263                   (stropt "DESTDIR" destdir)
    264                   (stropt "INSTALL_ROOT" destdir))
    265 
    266         :install/meson
    267         (checkrun :move :meson "install" "-C" builddir (stropt "--destdir" destdir))
    268 
    269         :install/waf
    270         (checkrun :move :waf "install" "-o" builddir "--destdir" destdir)
    271 
    272         :install/perl
    273         (checkrun :move :perl "./Build" "install" "--install_base" prefix "--destdir" destdir)
    274 
    275         :install/go
    276         (do
    277           (set prefix "")
    278           (checkrun :install/go :go "install" "-v")
    279           (checkrun :move :go "clean" "-modcache"))
    280 
    281         :install/npm
    282         (do
    283           (set prefix "")
    284           (checkrun :move :npm "install"
    285                     "-g"
    286                     "--install-links"
    287                     "--cache" (path/join builddir ".npm")
    288                     "--prefix" destdir))
    289 
    290         :install/jpm
    291         (checkrun :move
    292                   :jpm
    293                   (stropt "--dest-dir" destdir)
    294                   (stropt "--binpath" bindir)
    295                   (stropt "--manpath" (path/join mandir "man1"))
    296                   (stropt "--modpath" (path/join libdir "janet"))
    297                   (stropt "--libpath" libdir)
    298                   (stropt "--headerpath" (path/join headerdir "janet"))
    299                   "install")
    300 
    301         :install/rinstall
    302         (checkrun :move :rinstall "install" "-y" "--destdir" destdir "--packaging" "--prefix" prefix)
    303 
    304         :install/cargo
    305         (do
    306           (set prefix "")
    307           (checkrun :move :cargo "install" "--offline" "--frozen" "--no-track" "--root" destdir "--path" srcsubdir))
    308 
    309         :install/pip
    310         (utils/letsome wheels (libc/glob (path/join builddir "*.whl"))
    311            (checkrun :post/detectprefix
    312                      :pip "install"
    313                      (stropt "--root" destdir)
    314                      (stropt "--prefix" prefix)
    315                      "--no-build-isolation"
    316                      "--no-deps"
    317                      "--force-reinstall"
    318                      ;wheels)
    319            (errexit "No wheels present"))
    320 
    321         :post/detectprefix
    322         (do
    323           (if (file/dir-exists? (path/join destdir prefix "local")) (set prefix (path/join prefix "local")))
    324           (set state :move))
    325 
    326         :move
    327         (let [log_file (file/open "./instow.log" :a)
    328               installdir (path/join destdir prefix)]
    329           (if (file/dir-exists? installdir)
    330             (do
    331               (if (file/dir-exists? pkgdir)
    332                 (do
    333                   (checkrun :stow :stow "-v" "-d" stowdir "-t" target "-D" pkg)
    334                   (file/rmrf pkgdir)))
    335               (set state (if (nil? (libc/glob (path/join installdir "lib" "*.so.*"))) :stow :ldconfig))
    336               (if (not= state :error)
    337                 (nftw/nftw installdir
    338                            (fn [file stat ftype info]
    339                              (if (or (= ftype :f) (= ftype :sl))
    340                                (do
    341                                  (def dst (path/join pkgdir (string/slice file (length installdir))))
    342                                  (message state (string/format "MV: %s => %s" file dst) log_file)
    343                                  (file/move-file file dst))) 0) 1024 :phys)))
    344             (errexit "The destination directory doesn't contain the prefix"))
    345           (file/close log_file))
    346 
    347         :ldconfig
    348         (checkrun :stow :ldconfig "-vNn" (path/join pkgdir "lib"))
    349 
    350         :stow
    351         (checkrun :done :stow "-v" "-d" stowdir "-t" target pkg)
    352 
    353         :error
    354         (do
    355           (set ret 1)
    356           (printf "\x1b[2K{%s}⸉!⸊→%s" state errormsg)
    357           (set state :cleanup))
    358 
    359         :done
    360         (do
    361           (printf "\x1b[2K{%s}⸉x⸊→Success" state)
    362           (set state :cleanup))
    363 
    364         :cleanup
    365         (do
    366           (file/rmrf (string/join [destdir]))
    367           (set state :exit))
    368         
    369         #default
    370         (errexit (string "Unknown state: " state))))
    371 ret
    372 )