instow

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

main.janet (13059B)

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