├── .gitignore ├── COPYING ├── HACKING ├── Makefile.am ├── README ├── TODO ├── configure.ac ├── examples ├── LICENSE ├── Makefile.am ├── README └── build-basic-vm.sh ├── html └── pod.css ├── init ├── Makefile.am └── init.c ├── m4 └── ocaml.m4 ├── src ├── Makefile.am ├── bin2c.pl ├── config.ml.in ├── ext2fs-c.c ├── ext2fs.ml ├── ext2fs.mli ├── fnmatch-c.c ├── fnmatch.ml ├── fnmatch.mli ├── format-ext2-init-c.c ├── format_chroot.ml ├── format_chroot.mli ├── format_ext2.ml ├── format_ext2.mli ├── format_ext2_init.ml ├── format_ext2_init.mli ├── format_ext2_initrd.ml ├── format_ext2_initrd.mli ├── format_ext2_kernel.ml ├── format_ext2_kernel.mli ├── glob-c.c ├── glob.ml ├── glob.mli ├── librpm-c.c ├── librpm.ml ├── librpm.mli ├── mode_build.ml ├── mode_build.mli ├── mode_prepare.ml ├── mode_prepare.mli ├── os_release.ml ├── os_release.mli ├── package_handler.ml ├── package_handler.mli ├── ph_dpkg.ml ├── ph_dpkg.mli ├── ph_pacman.ml ├── ph_pacman.mli ├── ph_rpm.ml ├── ph_rpm.mli ├── realpath-c.c ├── realpath.ml ├── realpath.mli ├── supermin-link.sh.in ├── supermin.ml ├── supermin.pod ├── types.ml ├── utils.ml └── utils.mli ├── supermin-test-driver └── tests ├── Makefile.am ├── automake2junit.ml ├── test-basic.sh ├── test-binaries-exist-network.sh ├── test-binaries-exist.sh ├── test-build-bash-network.sh ├── test-build-bash.sh ├── test-execstack.sh ├── test-harder-network.sh ├── test-harder.sh └── test-if-newer-ext2.sh /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.a 3 | *.cdbs-orig 4 | *.cmi 5 | *.cmo 6 | *.cmx 7 | *.log 8 | *.o 9 | *.trs 10 | 11 | .deps 12 | Makefile 13 | Makefile.in 14 | pod2htm?.tmp 15 | 16 | /aclocal.m4 17 | /ar-lib 18 | /arg-nonnull.h 19 | /autom4te.cache 20 | /c++defs.h 21 | /compile 22 | /config.guess 23 | /config.h.in 24 | /config.h 25 | /config.log 26 | /config.status 27 | /config.sub 28 | /configure 29 | /cscope.out 30 | /depcomp 31 | /examples/basic-full-appliance 32 | /examples/basic-supermin.d 33 | /html/supermin-helper.1.html 34 | /html/supermin.1.html 35 | /init/init 36 | /local* 37 | /INSTALL 38 | /install-sh 39 | /missing 40 | /snippet/ 41 | /src/.depend 42 | /src/config.ml 43 | /src/format-ext2-init-bin.h 44 | /src/supermin 45 | /src/supermin.1 46 | /src/supermin-link.sh 47 | /stamp-h1 48 | /supermin-*.tar.gz 49 | /test-driver 50 | /warn-on-use.h 51 | -------------------------------------------------------------------------------- /HACKING: -------------------------------------------------------------------------------- 1 | Send patches to the libguestfs mailing list. 2 | 3 | ---------------------------------------------------------------------- 4 | 5 | If you want to write a package manager for a new Linux distro, then 6 | first look at the interface that you have to supply. It is documented 7 | in src/package_handler.mli. Secondly look at existing handlers, eg. 8 | src/rpm.ml, src/dpkg.ml. 9 | 10 | ---------------------------------------------------------------------- 11 | 12 | Overview of the source files: 13 | 14 | supermin.ml main program, argument parsing and coordination 15 | 16 | | 17 | +- prepare.ml Prepare mode (--prepare option) 18 | | 19 | +- build.ml Build mode (--build option) 20 | | 21 | +- chroot.ml Build a chroot (--build -f chroot) 22 | | 23 | +- ext2.ml Build an ext2 fs (--build -f ext2) 24 | | 25 | +- kernel.ml Find the right kernel to use 26 | | 27 | +- ext2_initrd.ml Build a minimal initrd 28 | 29 | Libraries used by both modes: 30 | 31 | | 32 | +- package_hander.mli 33 | +- package_hander.ml Package manager interface, for resolving 34 | | | package dependencies, list of files, etc. 35 | | | 36 | | +- rpm.ml Package manager implementation for RPM distros 37 | | | 38 | | +- dpkg.ml Package manager implementation for dpkg distros 39 | | | 40 | | +- etc. 41 | | 42 | +- config.ml Configuration (from autoconf) 43 | | 44 | +- types.ml Some global type declarations 45 | | 46 | +- utils.ml Some utility functions 47 | | 48 | +- fnmatch.ml Interface to fnmatch(3) 49 | | | 50 | | +- fnmatch-c.c Binding to fnmatch(3) 51 | +- etc. And other C bindings ... 52 | -------------------------------------------------------------------------------- /Makefile.am: -------------------------------------------------------------------------------- 1 | # supermin Makefile.am 2 | # (C) Copyright 2009-2016 Red Hat Inc. 3 | # 4 | # This program is free software; you can redistribute it and/or modify 5 | # it under the terms of the GNU General Public License as published by 6 | # the Free Software Foundation; either version 2 of the License, or 7 | # (at your option) any later version. 8 | # 9 | # This program is distributed in the hope that it will be useful, 10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | # GNU General Public License for more details. 13 | # 14 | # You should have received a copy of the GNU General Public License 15 | # along with this program; if not, write to the Free Software 16 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 17 | 18 | ACLOCAL_AMFLAGS = -I m4 19 | 20 | SUBDIRS = init src examples tests 21 | 22 | EXTRA_DIST = \ 23 | .gitignore \ 24 | HACKING \ 25 | html/pod.css \ 26 | README \ 27 | TODO \ 28 | $(SOURCES) 29 | 30 | # Maintainer website update. 31 | HTMLFILES = \ 32 | html/supermin.1.html 33 | 34 | WEBSITEDIR = $(HOME)/d/redhat/websites/libguestfs 35 | 36 | website: $(HTMLFILES) 37 | cp $(HTMLFILES) $(WEBSITEDIR) 38 | 39 | CLEANFILES = $(HTMLFILES) pod2*.tmp 40 | 41 | #---------------------------------------------------------------------- 42 | # Maintainers only! 43 | 44 | # Check no files are missing from EXTRA_DIST rules, and that all 45 | # generated files have been included in the tarball. (Note you must 46 | # have done 'make dist') 47 | maintainer-check-extra-dist: 48 | @zcat $(PACKAGE_NAME)-$(VERSION).tar.gz | tar tf - | sort | \ 49 | sed 's,^$(PACKAGE_NAME)-$(VERSION)/,,' > tarfiles 50 | @git ls-files | \ 51 | sort > gitfiles 52 | @comm -13 tarfiles gitfiles > comm-out 53 | @echo Checking for differences between EXTRA_DIST and git ... 54 | @cat comm-out 55 | @[ ! -s comm-out ] 56 | @rm tarfiles gitfiles comm-out 57 | @echo PASS: EXTRA_DIST tests 58 | 59 | # Commit everything in the current directory and set the commit 60 | # message to the current version number. 61 | maintainer-commit: 62 | git commit -a -m "Version $(VERSION)." 63 | 64 | # Tag HEAD with the current version. 65 | maintainer-tag: 66 | git tag -a v$(VERSION) -m "Version $(VERSION)." -f 67 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | supermin - Tool for creating supermin appliances 2 | by Richard W.M. Jones (rjones@redhat.com) 3 | http://people.redhat.com/~rjones/supermin 4 | ---------------------------------------------------------------------- 5 | 6 | Supermin is a tool for building supermin appliances. These are tiny 7 | appliances [similar to virtual machines], usually around 100KB in 8 | size, which get fully instantiated on-the-fly in a fraction of a 9 | second when you need to boot one of them. 10 | 11 | A complete description is in the supermin(1) man page. 12 | 13 | IMPORTANT NOTE FOR USERS OF SUPERMIN 4.x: supermin 5.x is a rewrite of 14 | supermin 4. It is compatible at a high level with supermin 4 / 15 | febootstrap 3, but requires some command line adjustments. 16 | 17 | IMPORTANT NOTE FOR USERS OF FEBOOTSTRAP 3.x: 18 | supermin 4.x is just an evolution of febootstrap 3.x (really we just 19 | renamed it). The previous febootstrap program is now called 20 | supermin. The previous febootstrap-supermin-helper program is now 21 | called supermin-helper. Apart from that they are identical, although 22 | they will evolve and add features over time. 23 | 24 | IMPORTANT NOTE FOR USERS OF FEBOOTSTRAP 2.x: 25 | febootstrap 3.x is a complete rewrite. febootstrap 2.x could only 26 | build Fedora distributions. This version can build many varieties 27 | of Linux distros. 3.x only builds supermin appliances, it does not 28 | build chroots. 3.x does not build cross-distro, cross-release or 29 | cross-architecture systems. If you want febootstrap 2.x, please use 30 | the 'febootstrap-2.x' branch from the git repository. 31 | 32 | Requirements 33 | ------------ 34 | 35 | ocaml 36 | 37 | ocaml findlib ("ocamlfind" program) 38 | 39 | perldoc 40 | - This is just used to generate the manpage. 41 | 42 | static libc 43 | - Can be replaced with dietlibc, musl-libc (and maybe other 44 | alternate libc). See section ``Alternate libc'' below. 45 | 46 | bash 47 | 48 | gcc 49 | 50 | gawk 51 | 52 | libcom_err 53 | libext2fs 54 | /sbin/mke2fs 55 | - These are part of e2fsprogs. 56 | 57 | For Fedora/RHEL: 58 | 59 | rpm 60 | librpm 61 | yumdownloader (from yum-utils) or 'dnf download' plugin 62 | 63 | NB: On RHEL, use `yum-builddep supermin' to install all the 64 | dependencies. On Fedora use `dnf builddep supermin'. 65 | 66 | For Debian/Ubuntu: 67 | 68 | dpkg 69 | apt-get 70 | 71 | NB: On Debian, use `apt-get build-dep supermin' to install all the 72 | dependencies. 73 | 74 | For openSUSE: 75 | 76 | rpm 77 | librpm 78 | zypper 79 | 80 | For Mageia: 81 | 82 | rpm 83 | librpm 84 | urpmi & fakeroot, or 'dnf download' plugin 85 | 86 | For Arch Linux: 87 | 88 | pacman 89 | fakeroot 90 | makepkg 91 | 92 | Optional 93 | -------- 94 | 95 | These are only needed if you plan to boot the supermin appliances you 96 | are building: 97 | 98 | qemu >= 0.13 99 | kernel >= 2.6.36 100 | 101 | zcat (command) - if your kernel uses gzipped modules 102 | 103 | xzcat (command) - if your kernel uses xz-compressed modules 104 | 105 | zstdcat (command) - if your kernel uses zstd-compressed modules 106 | 107 | Building and installing 108 | ----------------------- 109 | 110 | If you're cloning this from git the first time, do: 111 | 112 | autoreconf -i 113 | 114 | For normal builds, and building from the tarball: 115 | 116 | ./configure 117 | make 118 | 119 | You can run supermin without installing: 120 | 121 | ./src/supermin --help 122 | 123 | To install the software: 124 | 125 | sudo make install 126 | 127 | Tests 128 | ----- 129 | 130 | make check 131 | 132 | Note that the tests require a network connection. If you don't 133 | have a network connection (eg. for distro package building) then 134 | try doing: 135 | 136 | ./configure --disable-network-tests 137 | 138 | Examples 139 | -------- 140 | 141 | See the examples/ subdirectory. 142 | 143 | Feedback and bugs 144 | ----------------- 145 | 146 | Send feedback to guestfs@lists.libguestfs.org. You can file bugs in 147 | https://bugzilla.redhat.com/ (under "Fedora", "supermin") 148 | 149 | Alternate libc 150 | -------------- 151 | 152 | Supermin uses a small, statically linked "init" binary. Normally this 153 | is linked to static glibc, but static glibc produces enormous binaries 154 | (800KB+). You can use an alternate libc if you prefer. For example, 155 | using dietlibc, I can build a 22K init, about 1/40th of the size. 156 | 157 | $ ls -l init/init 158 | -rwxrwxr-x. 1 rjones rjones 21736 Feb 17 14:03 init/init 159 | 160 | - Dietlibc 161 | 162 | For dietlibc, build supermin like this: 163 | 164 | ./configure 165 | make clean 166 | make -C init CC="diet gcc" 167 | make 168 | 169 | which builds the init using dietlibc, and then builds the rest of 170 | supermin with the dietlibc-using init binary. 171 | 172 | - Musl-libc 173 | 174 | For musl, build supermin like this: 175 | 176 | ./configure 177 | make clean 178 | make -C init CC="musl-gcc" 179 | make 180 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | Store %post scripts 2 | ------------------- 3 | 4 | Can we get the %post scripts and store them in a directory in the 5 | appliance? 6 | 7 | 8 | Some features of supermin 4 which were cut in supermin 5 9 | -------------------------------------------------------- 10 | 11 | - Frugalware / pacman-g2: requires 'pactree' tool to be packaged 12 | 13 | - write an initrd file (ie. '-f cpio') 14 | 15 | - --user/--group options 16 | -------------------------------------------------------------------------------- /configure.ac: -------------------------------------------------------------------------------- 1 | dnl supermin configure.ac 2 | dnl (C) Copyright 2009-2024 Red Hat Inc. 3 | dnl 4 | dnl This program is free software; you can redistribute it and/or modify 5 | dnl it under the terms of the GNU General Public License as published by 6 | dnl the Free Software Foundation; either version 2 of the License, or 7 | dnl (at your option) any later version. 8 | dnl 9 | dnl This program is distributed in the hope that it will be useful, 10 | dnl but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | dnl GNU General Public License for more details. 13 | dnl 14 | dnl You should have received a copy of the GNU General Public License 15 | dnl along with this program; if not, write to the Free Software 16 | dnl Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 17 | dnl 18 | dnl Written by Richard W.M. Jones 19 | 20 | dnl MAJOR = 5 (unless we break the command line again) 21 | dnl MINOR = even for stable branch, odd for development branch 22 | dnl RELEASE = increments for each release 23 | AC_INIT([supermin],[5.3.5]) 24 | 25 | AM_INIT_AUTOMAKE(foreign) 26 | AC_REQUIRE_AUX_FILE([supermin-test-driver]) 27 | 28 | dnl Check for basic C environment. 29 | AC_PROG_CC 30 | 31 | AC_PROG_INSTALL 32 | AC_PROG_CPP 33 | 34 | AC_C_PROTOTYPES 35 | test "x$U" != "x" && AC_MSG_ERROR([Compiler not ANSI compliant]) 36 | 37 | AM_PROG_CC_C_O 38 | 39 | dnl Enable GNU stuff. 40 | AC_USE_SYSTEM_EXTENSIONS 41 | 42 | dnl Check support for 64 bit file offsets. 43 | AC_SYS_LARGEFILE 44 | 45 | dnl Which header file defines major, minor, makedev. 46 | AC_HEADER_MAJOR 47 | 48 | dnl Define the host CPU architecture (defines host_cpu). 49 | AC_CANONICAL_HOST 50 | 51 | # Define $(SED). 52 | m4_ifdef([AC_PROG_SED],[ 53 | AC_PROG_SED 54 | ],[ 55 | dnl ... else hope for the best 56 | AC_SUBST([SED], "sed") 57 | ]) 58 | 59 | AC_ARG_ENABLE([werror], 60 | [AS_HELP_STRING([--enable-werror], 61 | [turn GCC warnings into errors (for developers)])], 62 | [case $enableval in 63 | yes|no) ;; 64 | *) AC_MSG_ERROR([bad value $enableval for werror option]) ;; 65 | esac 66 | gcc_werror=$enableval], 67 | [gcc_werror=no] 68 | ) 69 | if test "$gcc_werror" = "yes"; then 70 | WERROR_CFLAGS="-Werror" 71 | AC_SUBST([WERROR_CFLAGS]) 72 | fi 73 | 74 | # OCaml and ocamlfind are required to compile. 75 | AC_PROG_OCAML 76 | if test "$OCAMLC" = "no"; then 77 | AC_MSG_ERROR([You must install the OCaml compiler]) 78 | fi 79 | AM_CONDITIONAL([HAVE_OCAMLOPT],[test "$OCAMLBEST" = "opt"]) 80 | AC_PROG_FINDLIB 81 | if test "$OCAMLFIND" = "no"; then 82 | AC_MSG_ERROR([You must install OCaml findlib (the ocamlfind command)]) 83 | fi 84 | 85 | dnl Check if OCaml has caml_alloc_initialized_string (added 2017). 86 | AS_IF([test "x$OCAMLC" != "xno" && test "x$OCAMLFIND" != "xno"],[ 87 | AC_MSG_CHECKING([for caml_alloc_initialized_string]) 88 | cat >conftest.c <<'EOF' 89 | #include 90 | int main () { char *p = (void *) caml_alloc_initialized_string; return 0; } 91 | EOF 92 | AS_IF([$OCAMLC conftest.c >&AS_MESSAGE_LOG_FD 2>&1],[ 93 | AC_MSG_RESULT([yes]) 94 | AC_DEFINE([HAVE_CAML_ALLOC_INITIALIZED_STRING],[1], 95 | [caml_alloc_initialized_string found at compile time.]) 96 | ],[ 97 | AC_MSG_RESULT([no]) 98 | ]) 99 | rm -f conftest.c conftest.o 100 | ]) 101 | 102 | # NB: AC_CHECK_PROG(S) or AC_PATH_PROG(S)? 103 | # Use AC_CHECK_PROG(S) for programs which are only used during build. 104 | # Use AC_PATH_PROG(S) for program names which are compiled into the 105 | # binary and used at run time. The reason is so that we know which 106 | # programs the binary actually uses. 107 | 108 | dnl Optional programs. 109 | AC_CHECK_PROG(PERLDOC,[perldoc],[perldoc],[no]) 110 | if test "x$PERLDOC" = "xno" ; then 111 | AC_MSG_WARN([perldoc not found - install perl to make man pages]) 112 | fi 113 | AM_CONDITIONAL(HAVE_PERLDOC,[test "x$PERLDOC" != "xno"]) 114 | 115 | dnl For yum-rpm handler. 116 | AC_PATH_PROG(RPM,[rpm],[no]) 117 | AC_PATH_PROG(RPM2CPIO,[rpm2cpio],[no]) 118 | AC_PATH_PROG(YUMDOWNLOADER,[yumdownloader],[no]) 119 | AC_PATH_PROG(DNF,[dnf],[no]) 120 | PKG_CHECK_MODULES([LIBRPM], [rpm], [librpm=yes], [:]) 121 | if test "x$librpm" = "xyes"; then 122 | AC_DEFINE([HAVE_LIBRPM], [1], [Define if you have librpm]) 123 | fi 124 | 125 | dnl For Zypper handler. 126 | AC_PATH_PROG(ZYPPER,[zypper],[no]) 127 | 128 | dnl For URPMI handler. 129 | AC_PATH_PROG(URPMI,[urpmi],[no], [$PATH$PATH_SEPARATOR/usr/sbin]) 130 | 131 | dnl For Debian handler. 132 | AC_PATH_PROG(APT_GET,[apt-get],[no]) 133 | AC_PATH_PROG(DPKG,[dpkg],[no],[/usr/bin:/bin]) 134 | AC_PATH_PROG(DPKG_DEB,[dpkg-deb],[no],[/usr/bin:/bin]) 135 | AC_PATH_PROG(DPKG_QUERY,[dpkg-query],[no],[/usr/bin:/bin]) 136 | AC_PATH_PROG(DPKG_DIVERT,[[dpkg-divert]],[no],[/usr/bin:/bin]) 137 | 138 | dnl For FrugalWare handler (currently disabled). 139 | AC_PATH_PROG(PACMAN_G2,[pacman-g2],[no]) 140 | 141 | dnl For ArchLinux handler. 142 | AC_PATH_PROG(PACMAN,[pacman],[no]) 143 | AC_PATH_PROG(PACTREE,[pactree],[no]) 144 | AC_PATH_PROG(MAKEPKG,[makepkg],[no]) 145 | 146 | dnl Check for fakeroot, only used a few drivers where the host package 147 | dnl manager contains broken/unnecessary tests for root privs. 148 | AC_PATH_PROG(FAKEROOT,[fakeroot],[no]) 149 | 150 | dnl Check for zcat, only needed if you have gzip-compressed kernel modules. 151 | AC_PATH_PROG(ZCAT,[zcat],[no]) 152 | 153 | dnl Check for xzcat, only needed if you have xz-compressed kernel modules. 154 | AC_PATH_PROG(XZCAT,[xzcat],[no]) 155 | 156 | dnl Check for zstdcat, only needed if you have zstd-compressed kernel modules. 157 | AC_PATH_PROG(ZSTDCAT,[zstdcat],[no]) 158 | 159 | dnl mke2fs. 160 | AC_PATH_PROG([MKE2FS],[mke2fs],[no], 161 | [$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR]) 162 | if test "x$MKE2FS" = "xno" ; then 163 | AC_MSG_FAILURE([mke2fs program not found]) 164 | fi 165 | AC_SUBST([MKE2FS]) 166 | 167 | dnl RHEL 5 mke2fs needed -T instead of -t . Unhelpfully 168 | dnl the --help output doesn't mention this, so we have to test it. 169 | AC_MSG_CHECKING([$MKE2FS -t or -T]) 170 | rm -f conftest.img 171 | dd if=/dev/zero of=conftest.img bs=1024 count=1024 >&AS_MESSAGE_LOG_FD 2>&1 172 | if $MKE2FS -t ext2 -F -q conftest.img >&AS_MESSAGE_LOG_FD 2>&1 ; then 173 | MKE2FS_T_OPTION=-t 174 | elif $MKE2FS -T ext2 -F -q conftest.img >&AS_MESSAGE_LOG_FD 2>&1 ; then 175 | MKE2FS_T_OPTION=-T 176 | else 177 | AC_MSG_ERROR([$MKE2FS cannot create filesystems]) 178 | fi 179 | rm conftest.img 180 | AC_MSG_RESULT([$MKE2FS_T_OPTION]) 181 | AC_SUBST([MKE2FS_T_OPTION]) 182 | 183 | dnl ext2fs, com_err. 184 | PKG_CHECK_MODULES([EXT2FS], [ext2fs]) 185 | PKG_CHECK_MODULES([COM_ERR], [com_err]) 186 | 187 | dnl Requires ext2fs_close2 function, added in 2011. 188 | old_LIBS="$LIBS" 189 | LIBS="$EXT2FS_LIBS $COM_ERR_LIBS" 190 | AC_CHECK_FUNCS([ext2fs_close2]) 191 | LIBS="$old_LIBS" 192 | 193 | dnl GNU awk. 194 | AC_CHECK_PROG(GAWK,[gawk],[gawk],[no]) 195 | if test "x$GAWK" = "xno" ; then 196 | AC_MSG_FAILURE([gawk (GNU awk) not found]) 197 | fi 198 | 199 | dnl cpio 200 | AC_PATH_PROG([CPIO],[cpio],[no]) 201 | test "x$CPIO" = "xno" && 202 | AC_MSG_ERROR([cpio must be installed]) 203 | 204 | dnl Disable network tests. 205 | AC_ARG_ENABLE([network-tests], 206 | [AS_HELP_STRING([--disable-network-tests], 207 | [Disable tests that need a network connection.])], 208 | [], 209 | [enable_network_tests=yes]) 210 | AM_CONDITIONAL([NETWORK_TESTS], 211 | [test "x$enable_network_tests" = "xyes"]) 212 | 213 | AC_CONFIG_HEADERS([config.h]) 214 | AC_CONFIG_FILES([src/supermin-link.sh], 215 | [chmod +x,-w src/supermin-link.sh]) 216 | AC_CONFIG_FILES([Makefile 217 | examples/Makefile 218 | init/Makefile 219 | src/config.ml 220 | src/Makefile 221 | tests/Makefile]) 222 | AC_OUTPUT 223 | -------------------------------------------------------------------------------- /examples/LICENSE: -------------------------------------------------------------------------------- 1 | All the examples in the 'examples' subdirectory may be freely copied, 2 | modified and distributed without any restrictions. 3 | -------------------------------------------------------------------------------- /examples/Makefile.am: -------------------------------------------------------------------------------- 1 | # supermin Makefile.am 2 | # (C) Copyright 2013 Red Hat Inc. 3 | # 4 | # This program is free software; you can redistribute it and/or modify 5 | # it under the terms of the GNU General Public License as published by 6 | # the Free Software Foundation; either version 2 of the License, or 7 | # (at your option) any later version. 8 | # 9 | # This program is distributed in the hope that it will be useful, 10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | # GNU General Public License for more details. 13 | # 14 | # You should have received a copy of the GNU General Public License 15 | # along with this program; if not, write to the Free Software 16 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 17 | # 18 | # Written by Richard W.M. Jones 19 | 20 | EXTRA_DIST = \ 21 | LICENSE \ 22 | build-basic-vm.sh 23 | 24 | CLEANFILES = \ 25 | *~ \ 26 | init basic-kernel basic-initrd basic-root 27 | 28 | clean-local: 29 | rm -rf basic-supermin.d 30 | -------------------------------------------------------------------------------- /examples/README: -------------------------------------------------------------------------------- 1 | The examples in this directory will give you some ideas how to run supermin. 2 | 3 | You can run them from this directory, eg: 4 | 5 | ./build-basic-vm.sh 6 | 7 | - You will need to build supermin first. 8 | 9 | - Read the scripts first! 10 | 11 | - They do NOT need root privileges, and are safe to run. 12 | -------------------------------------------------------------------------------- /examples/build-basic-vm.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash - 2 | 3 | set -e 4 | 5 | # This script builds a simple VM that just contains bash (plus any 6 | # dependencies) and an init script that runs bash to give the user a 7 | # shell. Also included is coreutils so that commands such as 'ls' 8 | # will work. 9 | 10 | if [ "$(id -u)" -eq "0" ]; then 11 | echo "Do not run this script as root!" 12 | exit 1 13 | fi 14 | 15 | #---------------------------------------------------------------------- 16 | 17 | # Prepare mode: 18 | 19 | pkgs="bash coreutils" 20 | 21 | echo "Building a supermin appliance containing $pkgs ..." 22 | echo 23 | 24 | # Create a supermin appliance in basic-supermin.d/ subdirectory. 25 | rm -rf basic-supermin.d 26 | mkdir basic-supermin.d 27 | ../src/supermin --prepare $pkgs -o basic-supermin.d 28 | 29 | # Create an init script. 30 | rm -f init 31 | cat > init < h1:first-of-type { 44 | display: none; 45 | } 46 | 47 | body > h1:first-of-type + p { 48 | font-size: 125%; 49 | font-weight: bold; 50 | color: rgb(204,0,0); 51 | margin-left: -32px; 52 | } 53 | 54 | /* Warning heading in man pages. */ 55 | a[name="warning"] { 56 | -moz-border-radius-topleft: 5px; 57 | -moz-border-radius-topright: 5px; 58 | border-radius-topleft: 5px; 59 | border-radius-topright: 5px; 60 | 61 | color: white; 62 | background-color: rgb(204,0,0); 63 | } 64 | a[name="warning"]:before { 65 | content: "\00a0\00a0\00a0"; 66 | } 67 | a[name="warning"]:after { 68 | content: "\00a0\00a0\00a0"; 69 | } 70 | 71 | /* Put the index on the right hand side in a floating box. */ 72 | div[name="index"] { 73 | float: right; 74 | width: 18em; 75 | border-left: 3em solid white; 76 | background-color: #fcfcfc; 77 | margin-top: 32px; 78 | padding-top: 0px; 79 | margin-left: 1em; 80 | padding-left: 1em; 81 | padding-right: 1em; 82 | font-size: 90%; 83 | } 84 | 85 | div[name="index"] a[href] { 86 | text-decoration: none; 87 | } 88 | 89 | div[name="index"] a[href]:hover { 90 | text-decoration: underline; 91 | } 92 | 93 | div[name="index"] a[href]:before { 94 | content: '#\00a0'; 95 | color: rgb(204,0,0); 96 | font-size: x-small; 97 | } 98 | 99 | div[name="index"] > ul { 100 | width: 17em; 101 | list-style: none; 102 | margin-left: 0px; 103 | margin-right: 0px; 104 | padding-left: 0px; 105 | padding-right: 0px; 106 | } 107 | 108 | div[name="index"] > ul > li { 109 | margin-bottom: 0.5em; 110 | } 111 | 112 | div[name="index"] > ul ul { 113 | width: 16em; 114 | list-style: none; 115 | margin-left: 0px; 116 | margin-right: 0px; 117 | padding-left: 0px; 118 | padding-right: 0px; 119 | margin-bottom: 0.5em; 120 | } 121 | 122 | div[name="index"] > ul > ul li { 123 | display: inline; 124 | margin-right: 1em; 125 | } 126 | 127 | /* 128 | div[name="index"] > ul > ul li:after { 129 | color: #ccc; 130 | content: '\2014'; 131 | } 132 | */ 133 | 134 | /* Get rid of those horrible
's :-( */ 135 | hr { display: none; } 136 | 137 | /* Demote

's and set rest of headers relative. */ 138 | h1 { 139 | font-size: 100%; 140 | color: black; 141 | border-bottom: solid 1px rgb(204,0,0); 142 | } 143 | 144 | h2 { 145 | font-size: 95%; 146 | border-bottom: none; 147 | } 148 | 149 | h3 { 150 | font-size: 90%; 151 | } 152 | 153 | h4 { 154 | font-size: 85%; 155 | } 156 | -------------------------------------------------------------------------------- /init/Makefile.am: -------------------------------------------------------------------------------- 1 | # supermin Makefile.am 2 | # (C) Copyright 2009-2016 Red Hat Inc. 3 | # 4 | # This program is free software; you can redistribute it and/or modify 5 | # it under the terms of the GNU General Public License as published by 6 | # the Free Software Foundation; either version 2 of the License, or 7 | # (at your option) any later version. 8 | # 9 | # This program is distributed in the hope that it will be useful, 10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | # GNU General Public License for more details. 13 | # 14 | # You should have received a copy of the GNU General Public License 15 | # along with this program; if not, write to the Free Software 16 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 17 | 18 | # init "script" used by ext2 initrd. 19 | 20 | CLEANFILES = *~ 21 | 22 | # You can build this using an alternate libc if you want. See 23 | # README ``Alternate libc''. 24 | 25 | noinst_PROGRAMS = init 26 | init_SOURCES = init.c 27 | init_CFLAGS = -static 28 | init_LDFLAGS = -static 29 | -------------------------------------------------------------------------------- /m4/ocaml.m4: -------------------------------------------------------------------------------- 1 | dnl autoconf macros for OCaml 2 | dnl 3 | dnl Copyright © 2009 Richard W.M. Jones 4 | dnl Copyright © 2009 Stefano Zacchiroli 5 | dnl Copyright © 2000-2005 Olivier Andrieu 6 | dnl Copyright © 2000-2005 Jean-Christophe Filliâtre 7 | dnl Copyright © 2000-2005 Georges Mariano 8 | dnl 9 | dnl For documentation, please read the ocaml.m4 man page. 10 | 11 | AC_DEFUN([AC_PROG_OCAML], 12 | [dnl 13 | # checking for ocamlc 14 | AC_CHECK_TOOL([OCAMLC],[ocamlc],[no]) 15 | 16 | if test "$OCAMLC" != "no"; then 17 | OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version* *\(.*\)$|\1|p'` 18 | AC_MSG_RESULT([OCaml version is $OCAMLVERSION]) 19 | # If OCAMLLIB is set, use it 20 | if test "$OCAMLLIB" = ""; then 21 | OCAMLLIB=`$OCAMLC -where 2>/dev/null || $OCAMLC -v|tail -1|cut -d ' ' -f 4` 22 | else 23 | AC_MSG_RESULT([OCAMLLIB previously set; preserving it.]) 24 | fi 25 | AC_MSG_RESULT([OCaml library path is $OCAMLLIB]) 26 | 27 | AC_SUBST([OCAMLVERSION]) 28 | AC_SUBST([OCAMLLIB]) 29 | 30 | # checking for ocamlopt 31 | AC_CHECK_TOOL([OCAMLOPT],[ocamlopt],[no]) 32 | OCAMLBEST=byte 33 | if test "$OCAMLOPT" = "no"; then 34 | AC_MSG_WARN([Cannot find ocamlopt; bytecode compilation only.]) 35 | else 36 | TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` 37 | if test "$TMPVERSION" != "$OCAMLVERSION" ; then 38 | AC_MSG_RESULT([versions differs from ocamlc; ocamlopt discarded.]) 39 | OCAMLOPT=no 40 | else 41 | OCAMLBEST=opt 42 | fi 43 | fi 44 | 45 | AC_SUBST([OCAMLBEST]) 46 | 47 | # checking for ocamlc.opt 48 | AC_CHECK_TOOL([OCAMLCDOTOPT],[ocamlc.opt],[no]) 49 | if test "$OCAMLCDOTOPT" != "no"; then 50 | TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` 51 | if test "$TMPVERSION" != "$OCAMLVERSION" ; then 52 | AC_MSG_RESULT([versions differs from ocamlc; ocamlc.opt discarded.]) 53 | else 54 | OCAMLC=$OCAMLCDOTOPT 55 | fi 56 | fi 57 | 58 | # checking for ocamlopt.opt 59 | if test "$OCAMLOPT" != "no" ; then 60 | AC_CHECK_TOOL([OCAMLOPTDOTOPT],[ocamlopt.opt],[no]) 61 | if test "$OCAMLOPTDOTOPT" != "no"; then 62 | TMPVERSION=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` 63 | if test "$TMPVERSION" != "$OCAMLVERSION" ; then 64 | AC_MSG_RESULT([version differs from ocamlc; ocamlopt.opt discarded.]) 65 | else 66 | OCAMLOPT=$OCAMLOPTDOTOPT 67 | fi 68 | fi 69 | fi 70 | 71 | AC_SUBST([OCAMLOPT]) 72 | fi 73 | 74 | AC_SUBST([OCAMLC]) 75 | 76 | # checking for ocaml toplevel 77 | AC_CHECK_TOOL([OCAML],[ocaml],[no]) 78 | 79 | # checking for ocamldep 80 | AC_CHECK_TOOL([OCAMLDEP],[ocamldep],[no]) 81 | 82 | # checking for ocamlmktop 83 | AC_CHECK_TOOL([OCAMLMKTOP],[ocamlmktop],[no]) 84 | 85 | # checking for ocamlmklib 86 | AC_CHECK_TOOL([OCAMLMKLIB],[ocamlmklib],[no]) 87 | 88 | # checking for ocamldoc 89 | AC_CHECK_TOOL([OCAMLDOC],[ocamldoc],[no]) 90 | 91 | # checking for ocamlbuild 92 | AC_CHECK_TOOL([OCAMLBUILD],[ocamlbuild],[no]) 93 | ]) 94 | 95 | 96 | AC_DEFUN([AC_PROG_OCAMLLEX], 97 | [dnl 98 | # checking for ocamllex 99 | AC_CHECK_TOOL([OCAMLLEX],[ocamllex],[no]) 100 | if test "$OCAMLLEX" != "no"; then 101 | AC_CHECK_TOOL([OCAMLLEXDOTOPT],[ocamllex.opt],[no]) 102 | if test "$OCAMLLEXDOTOPT" != "no"; then 103 | OCAMLLEX=$OCAMLLEXDOTOPT 104 | fi 105 | fi 106 | AC_SUBST([OCAMLLEX]) 107 | ]) 108 | 109 | AC_DEFUN([AC_PROG_OCAMLYACC], 110 | [dnl 111 | AC_CHECK_TOOL([OCAMLYACC],[ocamlyacc],[no]) 112 | AC_SUBST([OCAMLYACC]) 113 | ]) 114 | 115 | 116 | AC_DEFUN([AC_PROG_CAMLP4], 117 | [dnl 118 | AC_REQUIRE([AC_PROG_OCAML])dnl 119 | 120 | # checking for camlp4 121 | AC_CHECK_TOOL([CAMLP4],[camlp4],[no]) 122 | if test "$CAMLP4" != "no"; then 123 | TMPVERSION=`$CAMLP4 -v 2>&1| sed -n -e 's|.*version *\(.*\)$|\1|p'` 124 | if test "$TMPVERSION" != "$OCAMLVERSION" ; then 125 | AC_MSG_RESULT([versions differs from ocamlc]) 126 | CAMLP4=no 127 | fi 128 | fi 129 | AC_SUBST([CAMLP4]) 130 | 131 | # checking for companion tools 132 | AC_CHECK_TOOL([CAMLP4BOOT],[camlp4boot],[no]) 133 | AC_CHECK_TOOL([CAMLP4O],[camlp4o],[no]) 134 | AC_CHECK_TOOL([CAMLP4OF],[camlp4of],[no]) 135 | AC_CHECK_TOOL([CAMLP4OOF],[camlp4oof],[no]) 136 | AC_CHECK_TOOL([CAMLP4ORF],[camlp4orf],[no]) 137 | AC_CHECK_TOOL([CAMLP4PROF],[camlp4prof],[no]) 138 | AC_CHECK_TOOL([CAMLP4R],[camlp4r],[no]) 139 | AC_CHECK_TOOL([CAMLP4RF],[camlp4rf],[no]) 140 | AC_SUBST([CAMLP4BOOT]) 141 | AC_SUBST([CAMLP4O]) 142 | AC_SUBST([CAMLP4OF]) 143 | AC_SUBST([CAMLP4OOF]) 144 | AC_SUBST([CAMLP4ORF]) 145 | AC_SUBST([CAMLP4PROF]) 146 | AC_SUBST([CAMLP4R]) 147 | AC_SUBST([CAMLP4RF]) 148 | ]) 149 | 150 | 151 | AC_DEFUN([AC_PROG_FINDLIB], 152 | [dnl 153 | AC_REQUIRE([AC_PROG_OCAML])dnl 154 | 155 | # checking for ocamlfind 156 | AC_CHECK_TOOL([OCAMLFIND],[ocamlfind],[no]) 157 | AC_SUBST([OCAMLFIND]) 158 | ]) 159 | 160 | 161 | dnl Thanks to Jim Meyering for working this next bit out for us. 162 | dnl XXX We should define AS_TR_SH if it's not defined already 163 | dnl (eg. for old autoconf). 164 | AC_DEFUN([AC_CHECK_OCAML_PKG], 165 | [dnl 166 | AC_REQUIRE([AC_PROG_FINDLIB])dnl 167 | 168 | AC_MSG_CHECKING([for OCaml findlib package $1]) 169 | 170 | unset found 171 | unset pkg 172 | found=no 173 | for pkg in $1 $2 ; do 174 | if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then 175 | AC_MSG_RESULT([found]) 176 | AS_TR_SH([OCAML_PKG_$1])=$pkg 177 | found=yes 178 | break 179 | fi 180 | done 181 | if test "$found" = "no" ; then 182 | AC_MSG_RESULT([not found]) 183 | AS_TR_SH([OCAML_PKG_$1])=no 184 | fi 185 | 186 | AC_SUBST(AS_TR_SH([OCAML_PKG_$1])) 187 | ]) 188 | 189 | 190 | AC_DEFUN([AC_CHECK_OCAML_MODULE], 191 | [dnl 192 | AC_MSG_CHECKING([for OCaml module $2]) 193 | 194 | cat > conftest.ml <&5 2>&5 ; then 200 | found=yes 201 | break 202 | fi 203 | done 204 | 205 | if test "$found" ; then 206 | AC_MSG_RESULT([$$1]) 207 | else 208 | AC_MSG_RESULT([not found]) 209 | $1=no 210 | fi 211 | AC_SUBST([$1]) 212 | ]) 213 | 214 | 215 | dnl XXX Cross-compiling 216 | AC_DEFUN([AC_CHECK_OCAML_WORD_SIZE], 217 | [dnl 218 | AC_REQUIRE([AC_PROG_OCAML])dnl 219 | AC_MSG_CHECKING([for OCaml compiler word size]) 220 | cat > conftest.ml < conftest.ml < $@-t 176 | mv $@-t $@ 177 | 178 | -include .depend 179 | 180 | SUFFIXES = .cmo .cmi .cmx .ml .mli .mll .mly 181 | 182 | if HAVE_PERLDOC 183 | 184 | supermin.1: $(srcdir)/supermin.pod 185 | pod2man \ 186 | -u \ 187 | --section 1 \ 188 | -c "Virtualization Support" \ 189 | --release "$(PACKAGE_NAME)-$(PACKAGE_VERSION)" \ 190 | $< > $@ 191 | 192 | noinst_DATA = \ 193 | ../html/supermin.1.html 194 | 195 | ../html/supermin.1.html: $(srcdir)/supermin.pod 196 | mkdir -p ../html 197 | pod2html \ 198 | --css 'pod.css' \ 199 | --htmldir ../html \ 200 | --outfile ../html/supermin.1.html \ 201 | $< 202 | 203 | endif 204 | -------------------------------------------------------------------------------- /src/bin2c.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # (C) Copyright 2009-2016 Hilko Bengen. 3 | # 4 | # This program is free software; you can redistribute it and/or modify 5 | # it under the terms of the GNU General Public License as published by 6 | # the Free Software Foundation; either version 2 of the License, or 7 | # (at your option) any later version. 8 | # 9 | # This program is distributed in the hope that it will be useful, 10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | # GNU General Public License for more details. 13 | # 14 | # You should have received a copy of the GNU General Public License 15 | # along with this program; if not, write to the Free Software 16 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 17 | 18 | # This script creates a C snippet embedding an arbitrary file 19 | # 20 | # The output provides two variables: 21 | # static const char _binary_$name[]; 22 | # static const size_t _binary_$name_len; 23 | 24 | use strict; 25 | use warnings; 26 | 27 | die "usage: $0 \n" if @ARGV != 2; 28 | 29 | my ($infile, $outfile) = @ARGV; 30 | my ($buf, $i, $sz); 31 | open my $ifh, '<', $infile or die "open $infile: $!"; 32 | open my $ofh, '>', $outfile or die "open $outfile: $!"; 33 | 34 | my $infile_basename = $infile; 35 | $infile_basename =~ s{.*/}{}; 36 | 37 | print $ofh <<"EOF"; 38 | /* This file has been automatically generated from $infile by $0 */ 39 | 40 | static const char _binary_${infile_basename}[] = { 41 | EOF 42 | 43 | $sz = 0; 44 | while ( $i = read $ifh, $buf, 12 ) { 45 | print $ofh " " 46 | . join( ", ", map { sprintf '0x%02x', ord $_ } split //, $buf ) . ",\n"; 47 | $sz += $i; 48 | } 49 | die "read $infile (at offset $sz): $!\n" if not defined $i; 50 | close $ifh; 51 | 52 | print $ofh <<"EOF"; 53 | }; 54 | static const size_t _binary_${infile_basename}_len = ${sz}; 55 | EOF 56 | 57 | close $ofh; 58 | -------------------------------------------------------------------------------- /src/config.ml.in: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * @configure_input@ 4 | * 5 | * This program is free software; you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License as published by 7 | * the Free Software Foundation; either version 2 of the License, or 8 | * (at your option) any later version. 9 | * 10 | * This program is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU General Public License 16 | * along with this program; if not, write to the Free Software 17 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 18 | *) 19 | 20 | let package_name = "@PACKAGE_NAME@" 21 | let package_version = "@PACKAGE_VERSION@" 22 | let host_cpu = "@host_cpu@" 23 | 24 | let apt_get = "@APT_GET@" 25 | let cpio = "@CPIO@" 26 | let dnf = "@DNF@" 27 | let dpkg = "@DPKG@" 28 | let dpkg_deb = "@DPKG_DEB@" 29 | let dpkg_query = "@DPKG_QUERY@" 30 | let dpkg_divert = "@DPKG_DIVERT@" 31 | let fakeroot = "@FAKEROOT@" 32 | let makepkg = "@MAKEPKG@" 33 | let pacman = "@PACMAN@" 34 | let pactree = "@PACTREE@" 35 | let pacman_g2 = "@PACMAN_G2@" 36 | let rpm = "@RPM@" 37 | let rpm2cpio = "@RPM2CPIO@" 38 | let urpmi = "@URPMI@" 39 | let yumdownloader = "@YUMDOWNLOADER@" 40 | let xzcat = "@XZCAT@" 41 | let zcat = "@ZCAT@" 42 | let zstdcat = "@ZSTDCAT@" 43 | let zypper = "@ZYPPER@" 44 | 45 | let mke2fs = "@MKE2FS@" 46 | let mke2fs_t_option = "@MKE2FS_T_OPTION@" 47 | -------------------------------------------------------------------------------- /src/ext2fs.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | type t 20 | 21 | external ext2fs_open : string -> ?debug:int -> t = "supermin_ext2fs_open" 22 | external ext2fs_close : t -> unit = "supermin_ext2fs_close" 23 | 24 | external ext2fs_read_bitmaps : t -> unit = "supermin_ext2fs_read_bitmaps" 25 | external ext2fs_copy_file_from_host : t -> string -> string -> unit = "supermin_ext2fs_copy_file_from_host" 26 | external ext2fs_copy_dir_recursively_from_host : t -> string -> string -> unit = "supermin_ext2fs_copy_dir_recursively_from_host" 27 | external ext2fs_chmod : t -> string -> Unix.file_perm -> unit = "supermin_ext2fs_chmod" 28 | external ext2fs_chown : t -> string -> int -> int -> unit = "supermin_ext2fs_chown" 29 | -------------------------------------------------------------------------------- /src/ext2fs.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** {2 The [Ext2fs] module} 20 | 21 | The [Ext2fs] module provides a slightly simplified interface to 22 | the ext2fs library. Where we don't use flags/parameters/etc they 23 | are not exposed to OCaml. 24 | *) 25 | 26 | type t 27 | 28 | val ext2fs_open : string -> ?debug:int -> t 29 | val ext2fs_close : t -> unit 30 | 31 | val ext2fs_read_bitmaps : t -> unit 32 | val ext2fs_copy_file_from_host : t -> string -> string -> unit 33 | val ext2fs_copy_dir_recursively_from_host : t -> string -> string -> unit 34 | val ext2fs_chmod : t -> string -> Unix.file_perm -> unit 35 | val ext2fs_chown : t -> string -> int -> int -> unit 36 | -------------------------------------------------------------------------------- /src/fnmatch-c.c: -------------------------------------------------------------------------------- 1 | /* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | */ 18 | 19 | #include 20 | 21 | #include 22 | #include 23 | #include 24 | 25 | #include 26 | #include 27 | #include 28 | #include 29 | 30 | /* NB: These flags must appear in the same order as fnmatch.ml */ 31 | static int flags[] = { 32 | FNM_NOESCAPE, 33 | FNM_PATHNAME, 34 | FNM_PERIOD, 35 | FNM_FILE_NAME, 36 | FNM_LEADING_DIR, 37 | FNM_CASEFOLD, 38 | }; 39 | 40 | value 41 | supermin_fnmatch (value patternv, value strv, value flagsv) 42 | { 43 | CAMLparam3 (patternv, strv, flagsv); 44 | int f = 0, r; 45 | 46 | /* Convert flags to bitmask. */ 47 | while (flagsv != Val_int (0)) { 48 | f |= flags[Int_val (Field (flagsv, 0))]; 49 | flagsv = Field (flagsv, 1); 50 | } 51 | 52 | r = fnmatch (String_val (patternv), String_val (strv), f); 53 | 54 | if (r == 0) 55 | CAMLreturn (Val_true); 56 | else if (r == FNM_NOMATCH) 57 | CAMLreturn (Val_false); 58 | else { 59 | /* XXX The fnmatch specification doesn't mention what errors can 60 | * be returned by fnmatch. Assume they are errnos for now. 61 | */ 62 | unix_error (errno, (char *) "fnmatch", patternv); 63 | } 64 | } 65 | -------------------------------------------------------------------------------- /src/fnmatch.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (* NB: These flags must appear in the same order as fnmatch-c.c *) 20 | type flag = 21 | | FNM_NOESCAPE 22 | | FNM_PATHNAME 23 | | FNM_PERIOD 24 | | FNM_FILE_NAME 25 | | FNM_LEADING_DIR 26 | | FNM_CASEFOLD 27 | 28 | external fnmatch : string -> string -> flag list -> bool = "supermin_fnmatch" 29 | -------------------------------------------------------------------------------- /src/fnmatch.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | type flag = 20 | | FNM_NOESCAPE 21 | | FNM_PATHNAME 22 | | FNM_PERIOD 23 | | FNM_FILE_NAME 24 | | FNM_LEADING_DIR 25 | | FNM_CASEFOLD 26 | 27 | val fnmatch : string -> string -> flag list -> bool 28 | -------------------------------------------------------------------------------- /src/format-ext2-init-c.c: -------------------------------------------------------------------------------- 1 | /* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | */ 18 | 19 | #include 20 | 21 | #include 22 | #include 23 | #include 24 | #include 25 | 26 | #include 27 | #include 28 | 29 | /* The init binary. 30 | * See: bin2c.pl, init.c. 31 | */ 32 | #include 33 | 34 | /* Replacement if caml_alloc_initialized_string is missing, added 35 | * to OCaml runtime in 2017. 36 | */ 37 | #ifndef HAVE_CAML_ALLOC_INITIALIZED_STRING 38 | static inline value 39 | caml_alloc_initialized_string (mlsize_t len, const char *p) 40 | { 41 | value sv = caml_alloc_string (len); 42 | memcpy ((char *) String_val (sv), p, len); 43 | return sv; 44 | } 45 | #endif 46 | 47 | value 48 | supermin_binary_init (value unitv) 49 | { 50 | CAMLparam1 (unitv); 51 | CAMLlocal1 (sv); 52 | 53 | sv = caml_alloc_initialized_string (_binary_init_len, _binary_init); 54 | CAMLreturn (sv); 55 | } 56 | -------------------------------------------------------------------------------- /src/format_chroot.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | open Unix 20 | open Unix.LargeFile 21 | open Printf 22 | 23 | open Utils 24 | open Package_handler 25 | 26 | let build_chroot debug files outputdir packagelist_file = 27 | let do_copy src dest = 28 | if debug >= 2 then printf "supermin: chroot: copy %s\n%!" dest; 29 | let cmd = sprintf "cp -p %s %s" (quote src) (quote dest) in 30 | ignore (Sys.command cmd) 31 | in 32 | 33 | List.iter ( 34 | fun file -> 35 | try 36 | let path = file_source file in 37 | let st = lstat path in 38 | let opath = outputdir // file.ft_path in 39 | match st.st_kind with 40 | | S_DIR -> 41 | (* Note we fix up the permissions of directories in a second 42 | * pass, otherwise we risk creating a directory that we are 43 | * unable to write inside. GNU tar does the same thing! 44 | *) 45 | if debug >= 2 then printf "supermin: chroot: mkdir %s\n%!" opath; 46 | mkdir opath 0o700 47 | 48 | | S_LNK -> 49 | let link = readlink path in 50 | (* Need to turn absolute links into relative links, so they 51 | * always work, whether or not you are in a chroot. 52 | *) 53 | let link = 54 | if String.length link < 1 || link.[0] <> '/' then 55 | link 56 | else ( 57 | let link = ref link in 58 | for i = 1 to String.length path - 1 do 59 | if path.[i] = '/' then link := "../" ^ !link 60 | done; 61 | !link 62 | ) in 63 | 64 | if debug >= 2 then 65 | printf "supermin: chroot: link %s -> %s\n%!" opath link; 66 | symlink link opath 67 | 68 | | S_REG | S_CHR | S_BLK | S_FIFO | S_SOCK -> 69 | do_copy path opath 70 | with Unix_error _ -> () 71 | ) files; 72 | 73 | (* Add packagelist file, if requested. *) 74 | (match packagelist_file with 75 | | None -> () 76 | | Some filename -> 77 | if debug >= 1 then 78 | printf "supermin: chroot: creating /packagelist\n%!"; 79 | 80 | let opath = outputdir // "packagelist" in 81 | 82 | do_copy filename opath; 83 | (* Change the permissions of the file to be sure it is readable 84 | * by everyone. Unfortunately we cannot change the ownership, 85 | * as non-root users cannot give away files to other users. 86 | *) 87 | chmod opath 0o644 88 | ); 89 | 90 | (* Second pass: fix up directory permissions in reverse. *) 91 | let dirs = filter_map ( 92 | fun file -> 93 | let path = file_source file in 94 | let st = lstat path in 95 | if st.st_kind = S_DIR then Some (file.ft_path, st) else None 96 | ) files in 97 | List.iter ( 98 | fun (path, st) -> 99 | let opath = outputdir // path in 100 | (try chown opath st.st_uid st.st_gid with Unix_error _ -> ()); 101 | (try chmod opath st.st_perm with Unix_error _ -> ()) 102 | ) (List.rev dirs) 103 | -------------------------------------------------------------------------------- /src/format_chroot.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2016 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** Implements [--build -f chroot]. *) 20 | 21 | val build_chroot : int -> Package_handler.file list -> string -> string option -> unit 22 | (** [build_chroot debug files outputdir packagelist_file] copies the 23 | list of [files] into the chroot at [outputdir]. The optional 24 | [packagelist] controls creation of [/packagelist] within the 25 | chroot. *) 26 | -------------------------------------------------------------------------------- /src/format_ext2.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | open Unix 20 | open Unix.LargeFile 21 | open Printf 22 | 23 | open Utils 24 | open Ext2fs 25 | open Package_handler 26 | 27 | (* The ext2 image that we build has a size of 4GB if not specified, 28 | * and we 'hope' that the files fit in (otherwise we'll get an error). 29 | * Note that the file is sparsely allocated. 30 | * 31 | * The downside of allocating a very large initial disk is that the 32 | * fixed overhead of ext2 is larger (since ext2 calculates it based on 33 | * the size of the disk). For a 4GB disk the overhead is 34 | * approximately 66MB. 35 | *) 36 | let default_appliance_size = 4L *^ 1024L *^ 1024L *^ 1024L 37 | 38 | let build_ext2 debug basedir files modpath kernel_version appliance size 39 | packagelist_file = 40 | if debug >= 1 then 41 | printf "supermin: ext2: creating empty ext2 filesystem '%s'\n%!" appliance; 42 | 43 | let fd = openfile appliance [O_WRONLY;O_CREAT;O_TRUNC;O_NOCTTY] 0o644 in 44 | let size = 45 | match size with 46 | | None -> default_appliance_size 47 | | Some s -> s in 48 | LargeFile.ftruncate fd size; 49 | close fd; 50 | 51 | let cmd = 52 | sprintf "%s %s ext2 -F%s %s" 53 | Config.mke2fs Config.mke2fs_t_option 54 | (if debug >= 2 then "" else "q") 55 | (quote appliance) in 56 | run_command cmd; 57 | 58 | let fs = ext2fs_open ~debug appliance in 59 | ext2fs_read_bitmaps fs; 60 | 61 | if debug >= 1 then 62 | printf "supermin: ext2: populating from base image\n%!"; 63 | 64 | (* Read files from the base image, which has been unpacked into a 65 | * directory for us. 66 | *) 67 | ext2fs_copy_dir_recursively_from_host fs basedir "/"; 68 | 69 | if debug >= 1 then 70 | printf "supermin: ext2: copying files from host filesystem\n%!"; 71 | 72 | (* Copy files from host filesystem. *) 73 | List.iter ( 74 | fun file -> 75 | let src = file_source file in 76 | ext2fs_copy_file_from_host fs src file.ft_path 77 | ) files; 78 | 79 | (* Add packagelist file, if requested. *) 80 | (match packagelist_file with 81 | | None -> () 82 | | Some filename -> 83 | if debug >= 1 then 84 | printf "supermin: ext2: creating /packagelist\n%!"; 85 | 86 | ext2fs_copy_file_from_host fs filename "/packagelist"; 87 | (* Change the permissions and ownership of the file, to be sure 88 | * it is root-owned, and readable by everyone. 89 | *) 90 | ext2fs_chmod fs "/packagelist" 0o644; 91 | ext2fs_chown fs "/packagelist" 0 0 92 | ); 93 | 94 | if debug >= 1 then 95 | printf "supermin: ext2: copying kernel modules\n%!"; 96 | 97 | (* Import the kernel modules. *) 98 | (try 99 | ext2fs_copy_file_from_host fs "/lib" "/lib" 100 | with Unix_error _ -> 101 | (* If /lib doesn't exist on the host, create /lib directory 102 | * in the image, populating it with mode etc from host / 103 | *) 104 | ext2fs_copy_file_from_host fs "/" "/lib" 105 | ); 106 | 107 | (try 108 | ext2fs_copy_file_from_host fs "/lib/modules" "/lib/modules" 109 | with Unix_error _ -> 110 | (* As above, if /lib/modules does not exist on the host. *) 111 | ext2fs_copy_file_from_host fs "/" "/lib/modules" 112 | ); 113 | 114 | ext2fs_copy_dir_recursively_from_host fs 115 | modpath ("/lib/modules/" ^ kernel_version); 116 | 117 | ext2fs_close fs 118 | -------------------------------------------------------------------------------- /src/format_ext2.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2016 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** Implements [--build -f chroot]. *) 20 | 21 | val build_ext2 : int -> string -> Package_handler.file list -> string -> string -> string -> int64 option -> string option -> unit 22 | (** [build_ext2 debug basedir files modpath kernel_version appliance size 23 | packagelist_file] copies all the files from [basedir] plus the 24 | list of [files] into a newly created ext2 filesystem called [appliance]. 25 | 26 | Kernel modules are also copied in from the local [modpath] 27 | to the fixed path in the appliance [/lib/modules/]. 28 | 29 | libext2fs is used to populate the ext2 filesystem. *) 30 | -------------------------------------------------------------------------------- /src/format_ext2_init.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | external binary_init : unit -> string = "supermin_binary_init" 20 | -------------------------------------------------------------------------------- /src/format_ext2_init.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | val binary_init : unit -> string 20 | -------------------------------------------------------------------------------- /src/format_ext2_initrd.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2016 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | open Unix 20 | open Unix.LargeFile 21 | open Printf 22 | 23 | open Utils 24 | open Ext2fs 25 | open Fnmatch 26 | 27 | module StringSet = Set.Make (String) 28 | module StringMap = Map.Make (String) 29 | 30 | let string_set_of_list strs = List.fold_right StringSet.add strs StringSet.empty 31 | let keys map = StringMap.fold (fun k _ ks -> k :: ks) map [] 32 | 33 | (* The list of modules (wildcards) we consider for inclusion in the 34 | * mini initrd. Only what is needed in order to find a device with an 35 | * ext2 filesystem on it. 36 | *) 37 | let kmods = [ 38 | "ext2.ko*"; 39 | "ext4.ko*"; (* CONFIG_EXT4_USE_FOR_EXT23=y option might be set *) 40 | "virtio*.ko*"; 41 | "libata*.ko*"; 42 | "piix*.ko*"; 43 | "sd_mod.ko*"; 44 | "ata_piix.ko*"; 45 | "crc*.ko*"; 46 | "libcrc*.ko*"; 47 | "ibmvscsic.ko*"; 48 | "ibmvscsi.ko*"; 49 | "libnvdimm.ko*"; 50 | "nd_pmem.ko*"; 51 | "nd_btt.ko*"; 52 | "nfit.ko*"; 53 | ] 54 | 55 | (* A blacklist of kmods which match the above patterns, but which we 56 | * subsequently remove. 57 | *) 58 | let not_kmods = [ 59 | "virtio-gpu.ko*"; 60 | ] 61 | 62 | let rec build_initrd debug tmpdir modpath initrd = 63 | if debug >= 1 then 64 | printf "supermin: ext2: creating minimal initrd '%s'\n%!" initrd; 65 | 66 | let initdir = tmpdir // "init.d" in 67 | mkdir initdir 0o755; 68 | 69 | (* Read modules.dep file. *) 70 | let moddeps = read_module_deps modpath in 71 | 72 | (* Create a set of top-level modules, that is any module which 73 | * matches a pattern in kmods. 74 | *) 75 | let topset = 76 | let mods = keys moddeps in 77 | List.fold_left ( 78 | fun topset modl -> 79 | let m = Filename.basename modl in 80 | let matches wildcard = fnmatch wildcard m [FNM_PATHNAME] in 81 | if List.exists matches kmods && not (List.exists matches not_kmods) 82 | then 83 | StringSet.add modl topset 84 | else 85 | topset 86 | ) StringSet.empty mods in 87 | 88 | (* Do depth-first search to locate the modules we need to load. Keep 89 | * track of which modules we've added so we don't add them twice. 90 | *) 91 | let visited = ref StringSet.empty in 92 | let chan = open_out (initdir // "modules") in 93 | let rec visit set = 94 | StringSet.iter ( 95 | fun modl -> 96 | if not (StringSet.mem modl !visited) then ( 97 | visited := StringSet.add modl !visited; 98 | 99 | if debug >= 2 then 100 | printf "supermin: ext2: initrd: visiting module %s\n%!" modl; 101 | 102 | (* Visit dependencies first. *) 103 | let deps = 104 | try StringMap.find modl moddeps 105 | with Not_found -> StringSet.empty in 106 | visit deps; 107 | 108 | (* Copy module to the init directory. 109 | * Uncompress the module, if the name ends in .zst, .xz or .gz. 110 | *) 111 | let basename = Filename.basename modl in 112 | let basename = 113 | let len = String.length basename in 114 | if Config.zstdcat <> "no" && 115 | Filename.check_suffix basename ".zst" 116 | then ( 117 | let basename = String.sub basename 0 (len-4) in 118 | let cmd = sprintf "%s %s > %s" 119 | (quote Config.zstdcat) 120 | (quote (modpath // modl)) 121 | (quote (initdir // basename)) in 122 | if debug >= 2 then printf "supermin: %s\n" cmd; 123 | run_command cmd; 124 | basename 125 | ) 126 | else if Config.xzcat <> "no" && 127 | Filename.check_suffix basename ".xz" 128 | then ( 129 | let basename = String.sub basename 0 (len-3) in 130 | let cmd = sprintf "%s %s > %s" 131 | (quote Config.xzcat) 132 | (quote (modpath // modl)) 133 | (quote (initdir // basename)) in 134 | if debug >= 2 then printf "supermin: %s\n" cmd; 135 | run_command cmd; 136 | basename 137 | ) 138 | else if Config.zcat <> "no" && 139 | Filename.check_suffix basename ".gz" 140 | then ( 141 | let basename = String.sub basename 0 (len-3) in 142 | let cmd = sprintf "%s %s > %s" 143 | (quote Config.zcat) 144 | (quote (modpath // modl)) 145 | (quote (initdir // basename)) in 146 | if debug >= 2 then printf "supermin: %s\n" cmd; 147 | run_command cmd; 148 | basename 149 | ) 150 | else ( 151 | let cmd = 152 | sprintf "cp -t %s %s" 153 | (quote initdir) (quote (modpath // modl)) in 154 | if debug >= 2 then printf "supermin: %s\n" cmd; 155 | run_command cmd; 156 | basename 157 | ) in 158 | 159 | (* Write module name to 'modules' file. *) 160 | fprintf chan "%s\n" basename; 161 | ) 162 | ) set 163 | in 164 | visit topset; 165 | close_out chan; 166 | 167 | if debug >= 1 then 168 | printf "supermin: ext2: wrote %d modules to minimal initrd\n%!" (StringSet.cardinal !visited); 169 | 170 | (* This is the binary blob containing the init "script". *) 171 | let init = Format_ext2_init.binary_init () in 172 | let initfile = initdir // "init" in 173 | let chan = open_out initfile in 174 | output_string chan init; 175 | close_out chan; 176 | chmod initfile 0o755; 177 | 178 | (* Build the cpio file. *) 179 | let cmd = 180 | sprintf "(cd %s && (echo .; ls -1) | cpio --quiet -o -H newc) > %s" 181 | (quote initdir) (quote initrd) in 182 | run_command cmd 183 | 184 | (* Read modules.dep into internal structure. *) 185 | and read_module_deps modpath = 186 | let modules_dep = modpath // "modules.dep" in 187 | let chan = open_in modules_dep in 188 | let lines = input_all_lines chan in 189 | close_in chan; 190 | List.fold_left ( 191 | fun map line -> 192 | try 193 | let i = String.index line ':' in 194 | let modl = String.sub line 0 i in 195 | let deps = String.sub line (i+1) (String.length line - (i+1)) in 196 | let deps = 197 | if deps <> "" && deps <> " " then ( 198 | let deps = 199 | let len = String.length deps in 200 | if len >= 1 && deps.[0] = ' ' then String.sub deps 1 (len-1) 201 | else deps in 202 | let deps = string_split " " deps in 203 | string_set_of_list deps 204 | ) 205 | else StringSet.empty in 206 | StringMap.add modl deps map 207 | with Not_found -> map 208 | ) StringMap.empty lines 209 | -------------------------------------------------------------------------------- /src/format_ext2_initrd.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2016 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** Implements [--build -f ext2] minimal initrd which is required 20 | to mount the ext2 filesystem at runtime. 21 | 22 | See also the {!Format_ext2} module. *) 23 | 24 | val build_initrd : int -> string -> string -> string -> unit 25 | (** [build_initrd debug tmpdir modpath initrd] creates the minimal 26 | initrd required to mount the ext2 filesystem at runtime. 27 | 28 | A small, whitelisted selection of kernel modules is taken 29 | from [modpath], just enough to mount the appliance. 30 | 31 | The output is the file [initrd]. *) 32 | -------------------------------------------------------------------------------- /src/format_ext2_kernel.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | open Unix 20 | open Unix.LargeFile 21 | open Printf 22 | 23 | open Utils 24 | open Ext2fs 25 | open Fnmatch 26 | open Glob 27 | 28 | (* Similar but not the same as get_file_type in mode_build. There 29 | * is a case for deriving a common base utility. XXX 30 | *) 31 | type compression_type = GZip | Uncompressed 32 | let get_compression_type file = 33 | let chan = open_in file in 34 | let buf = Bytes.create 512 in 35 | let len = input chan buf 0 (Bytes.length buf) in 36 | close_in chan; 37 | let buf = Bytes.to_string buf in 38 | if len >= 3 && buf.[0] = '\x1f' && buf.[1] = '\x8b' && buf.[2] = '\x08' 39 | then GZip 40 | else Uncompressed (* or other unknown compression type *) 41 | 42 | let rec build_kernel debug host_cpu copy_kernel kernel = 43 | (* Locate the kernel. 44 | * SUPERMIN_* environment variables override everything. If those 45 | * are not present then we look in /lib/modules and /boot. 46 | *) 47 | let kernel_file, kernel_name, kernel_version, modpath = 48 | if debug >= 1 then 49 | printf "supermin: kernel: looking for kernel using environment variables ...\n%!"; 50 | match find_kernel_from_env_vars debug with 51 | | Some k -> k 52 | | None -> 53 | if debug >= 1 then 54 | printf "supermin: kernel: looking for kernels in /lib/modules/*/vmlinuz ...\n%!"; 55 | match find_kernel_from_lib_modules debug host_cpu with 56 | | Some k -> k 57 | | None -> 58 | if debug >= 1 then 59 | printf "supermin: kernel: looking for kernels in /boot ...\n%!"; 60 | match find_kernel_from_boot debug host_cpu with 61 | | Some k -> k 62 | | None -> 63 | error_no_kernels host_cpu in 64 | 65 | if debug >= 1 then ( 66 | printf "supermin: kernel: picked vmlinuz %s\n%!" kernel_file; 67 | printf "supermin: kernel: kernel_version %s\n" kernel_version; 68 | printf "supermin: kernel: modpath %s\n%!" modpath; 69 | ); 70 | 71 | (* RISC-V relies on the bootloader or firmware to uncompress the 72 | * kernel and doesn't have a concept of self-extracting kernels. 73 | * On Arm which is similar, qemu -kernel will automatically uncompress 74 | * the kernel, but qemu-system-riscv won't do that and the code is a 75 | * big mess so I don't fancy fixing it. So we have to detect that 76 | * case here and uncompress the kernel. 77 | *) 78 | let kernel_compression_type = get_compression_type kernel_file in 79 | if string_prefix "riscv" host_cpu && kernel_compression_type <> Uncompressed 80 | then 81 | copy_and_uncompress_kernel kernel_compression_type kernel_file kernel 82 | else 83 | copy_or_symlink_kernel copy_kernel kernel_file kernel; 84 | 85 | (kernel_version, modpath) 86 | 87 | and error_no_kernels host_cpu = 88 | error "\ 89 | failed to find a suitable kernel (host_cpu=%s). 90 | 91 | I looked for kernels in /boot and modules in /lib/modules. 92 | 93 | If this is a Xen guest, and you only have Xen domU kernels 94 | installed, try installing a fullvirt kernel (only for 95 | supermin use, you shouldn't boot the Xen guest with it)." 96 | host_cpu 97 | 98 | and find_kernel_from_env_vars debug = 99 | try 100 | let kernel_env = getenv "SUPERMIN_KERNEL" in 101 | if debug >= 1 then 102 | printf "supermin: kernel: SUPERMIN_KERNEL=%s\n%!" kernel_env; 103 | let kernel_version = 104 | try 105 | let v = getenv "SUPERMIN_KERNEL_VERSION" in 106 | if debug >= 1 then 107 | printf "supermin: kernel: SUPERMIN_KERNEL_VERSION=%s\n%!" v; 108 | v 109 | with Not_found -> 110 | match get_kernel_version debug kernel_env with 111 | | Some v -> v 112 | | None -> raise Not_found in 113 | let kernel_name = Filename.basename kernel_env in 114 | let modpath = find_modpath debug kernel_version in 115 | Some (kernel_env, kernel_name, kernel_version, modpath) 116 | with Not_found -> None 117 | 118 | and find_kernel_from_lib_modules debug host_cpu = 119 | let files = glob "/lib/modules/*/vmlinuz" [GLOB_NOSORT; GLOB_NOESCAPE] in 120 | let files = Array.to_list files in 121 | 122 | let files = ignore_unbootable_kernels host_cpu files in 123 | 124 | let kernels = 125 | let kernels = 126 | filter_map ( 127 | fun kernel_file -> 128 | let size = try (stat kernel_file).st_size with Unix_error _ -> 0L in 129 | if size < 10000_L then None 130 | else ( 131 | let kernel_name = Filename.basename kernel_file in 132 | let modpath = Filename.dirname kernel_file in 133 | let kernel_version = Filename.basename modpath in 134 | Some (kernel_file, kernel_name, kernel_version, modpath) 135 | ) 136 | ) files in 137 | List.sort ( 138 | fun (_, _, a, _) (_, _, b, _) -> compare_version b a 139 | ) kernels in 140 | 141 | match kernels with 142 | | kernel :: _ -> Some kernel 143 | | [] -> None 144 | 145 | and find_kernel_from_boot debug host_cpu = 146 | let all_files = Sys.readdir "/boot" in 147 | let all_files = Array.to_list all_files in 148 | 149 | (* In original: ls -1dvr /boot/vmlinuz-*.$arch* 2>/dev/null | grep -v xen *) 150 | let patterns = patt_of_cpu host_cpu in 151 | let files = files_matching_globs patterns all_files in 152 | let files = ignore_unbootable_kernels host_cpu files in 153 | 154 | let files = 155 | if files <> [] then files 156 | else ( 157 | (* In original: ls -1dvr /boot/vmlinuz-* 2>/dev/null | grep -v xen *) 158 | let files = files_matching_globs ["vmlinu?-*"] all_files in 159 | let files = ignore_unbootable_kernels host_cpu files in 160 | files 161 | ) in 162 | 163 | let files = List.sort (fun a b -> compare_version b a) files in 164 | let kernels = 165 | filter_map ( 166 | fun kernel_name -> 167 | let kernel_file = "/boot" // kernel_name in 168 | match get_kernel_version debug kernel_file with 169 | | None -> None 170 | | Some kernel_version -> 171 | let modpath = find_modpath debug kernel_version in 172 | if not (has_modpath modpath) then None 173 | else Some (kernel_file, kernel_name, kernel_version, modpath) 174 | ) files in 175 | 176 | match kernels with 177 | | kernel :: _ -> Some kernel 178 | | [] -> None 179 | 180 | and files_matching_globs patterns files = 181 | List.filter 182 | (fun filename -> 183 | List.exists 184 | (fun patt -> fnmatch patt filename [FNM_NOESCAPE]) patterns 185 | ) files 186 | 187 | and ignore_unbootable_kernels host_cpu files = 188 | let is_arm = 189 | String.length host_cpu >= 3 && 190 | host_cpu.[0] = 'a' && host_cpu.[1] = 'r' && host_cpu.[2] = 'm' in 191 | 192 | let files = 193 | List.filter (fun filename -> find filename "xen" = -1) files in 194 | let files = 195 | List.filter (fun filename -> find filename "zfcpdump" = -1) files in 196 | let files = 197 | List.filter (fun filename -> find filename "+debug" = -1) files in 198 | let files = 199 | if not is_arm then files 200 | else ( 201 | List.filter (fun filename -> 202 | find filename "tegra" = -1 203 | ) files 204 | ) in 205 | files 206 | 207 | and patt_of_cpu host_cpu = 208 | let models = 209 | match host_cpu with 210 | | "mips" | "mips64" -> [host_cpu; "*-malta"] 211 | | "ppc" | "powerpc" | "powerpc64" -> ["ppc"; "powerpc"; "powerpc64"] 212 | | "sparc" | "sparc64" -> ["sparc"; "sparc64"] 213 | | "amd64" | "x86_64" -> ["amd64"; "x86_64"] 214 | | "parisc" | "parisc64" -> ["hppa"; "hppa64"] 215 | | "ppc64el" -> ["powerpc64le"] 216 | | "aarch64" -> ["aarch64"; "arm64"] 217 | | _ when host_cpu.[0] = 'i' && host_cpu.[2] = '8' && host_cpu.[3] = '6' -> ["?86"] 218 | | _ when String.length host_cpu >= 5 && String.sub host_cpu 0 5 = "armv7" -> ["armmp"] 219 | | _ -> [host_cpu] 220 | in 221 | List.map (fun model -> sprintf "vmlinu?-*-%s" model) models 222 | 223 | and find_modpath debug kernel_version = 224 | try 225 | let modpath = getenv "SUPERMIN_MODULES" in 226 | if debug >= 1 then 227 | printf "supermin: kernel: SUPERMIN_MODULES=%s\n%!" modpath; 228 | modpath 229 | with Not_found -> 230 | let modpath = "/lib/modules/" ^ kernel_version in 231 | if debug >= 1 then 232 | printf "supermin: kernel: picked modules path %s\n%!" modpath; 233 | modpath 234 | 235 | and has_modpath modpath = 236 | try (stat (modpath // "modules.dep")).st_kind = S_REG 237 | with Unix_error _ -> false 238 | 239 | (* Extract the kernel version from a Linux kernel file. 240 | * 241 | * This first sees if we can get the information from the file 242 | * content (see below) and if that fails tries to parse the 243 | * filename. 244 | *) 245 | and get_kernel_version debug kernel_file = 246 | if debug >= 1 then 247 | printf "supermin: kernel: kernel version of %s%!" kernel_file; 248 | match get_kernel_version_from_file_content kernel_file with 249 | | Some version -> 250 | if debug >= 1 then printf " = %s (from content)\n%!" version; 251 | Some version 252 | | None -> 253 | (* Try to work it out from the filename instead. *) 254 | let basename = Filename.basename kernel_file in 255 | if string_prefix "vmlinuz-" basename || string_prefix "vmlinux-" basename 256 | then ( 257 | let version = String.sub basename 8 (String.length basename - 8) in 258 | (* Does the version look reasonable? *) 259 | let modpath = "/lib/modules" // version in 260 | if has_modpath modpath then ( 261 | if debug >= 1 then printf " = %s (from filename)\n%!" version; 262 | Some version 263 | ) else ( 264 | if debug >= 1 then printf " = error, no modpath\n%!"; 265 | None 266 | ) 267 | ) 268 | else ( 269 | if debug >= 1 then printf " = error, cannot parse filename\n%!"; 270 | None 271 | ) 272 | 273 | (* Extract the kernel version from a Linux kernel file. 274 | * 275 | * Returns a string containing the version or [None] if the 276 | * file can't be read, is not a Linux kernel, or the version can't 277 | * be found. 278 | * 279 | * See ftp://ftp.astron.com/pub/file/file-.tar.gz 280 | * (file-/magic/Magdir/linux) for the rules used to find the 281 | * version number: 282 | * 514 string HdrS Linux kernel 283 | * >518 leshort >0x1ff 284 | * >>(526.s+0x200) string >\0 version %s, 285 | * 286 | * Bugs: probably limited to x86 kernels. 287 | *) 288 | and get_kernel_version_from_file_content file = 289 | try 290 | let chan = open_in file in 291 | let buf = read_string chan 514 4 in 292 | if buf <> "HdrS" then ( 293 | close_in chan; 294 | raise Not_found 295 | ); 296 | let s = read_leshort chan 518 in 297 | if s < 0x1ff then ( 298 | close_in chan; 299 | raise Not_found 300 | ); 301 | let offset = read_leshort chan 526 in 302 | if offset < 0 then ( 303 | close_in chan; 304 | raise Not_found 305 | ); 306 | let buf = read_string chan (offset + 0x200) 132 in 307 | close_in chan; 308 | let rec loop i = 309 | if i < 132 then ( 310 | if buf.[i] = '\000' || buf.[i] = ' ' || 311 | buf.[i] = '\t' || buf.[i] = '\n' then 312 | String.sub buf 0 i 313 | else 314 | loop (i+1) 315 | ) 316 | else raise Not_found 317 | in 318 | let version = loop 0 in 319 | Some version 320 | with 321 | | Not_found 322 | | End_of_file 323 | | Sys_error _ 324 | | Invalid_argument _ -> None 325 | 326 | (* Read an unsigned little endian short at a specified offset in a file. *) 327 | and read_leshort chan offset = 328 | let buf = read_string chan offset 2 in 329 | (Char.code buf.[1] lsl 8) lor Char.code buf.[0] 330 | 331 | and read_string chan offset len = 332 | seek_in chan offset; 333 | let buf = Bytes.create len in 334 | really_input chan buf 0 len; 335 | Bytes.to_string buf 336 | 337 | and copy_and_uncompress_kernel compression_type src dest = 338 | let cmd = 339 | match compression_type with 340 | | GZip -> sprintf "zcat %s > %s" (quote src) (quote dest) 341 | | Uncompressed -> sprintf "cp %s %s" (quote src) (quote dest) in 342 | run_command cmd 343 | 344 | and copy_or_symlink_kernel copy_kernel src dest = 345 | if not copy_kernel then 346 | symlink src dest 347 | else ( 348 | (* NB: Do not use -p here, we want the kernel to appear newer 349 | * so that --if-newer works. 350 | *) 351 | let cmd = sprintf "cp %s %s" (quote src) (quote dest) in 352 | run_command cmd 353 | ) 354 | -------------------------------------------------------------------------------- /src/format_ext2_kernel.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2016 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** For [--build -f ext2] this module chooses a kernel to use 20 | and either links to it or copies it. 21 | 22 | See also the {!Format_ext2} module. *) 23 | 24 | val build_kernel : int -> string -> bool -> string -> string * string 25 | (** [build_kernel debug host_cpu copy_kernel kernel] 26 | chooses the kernel to use and links to it or copies it into the 27 | appliance directory. 28 | 29 | The output is written to the file [kernel]. 30 | 31 | The function returns the [kernel_version, modpath] tuple as a 32 | side-effect of locating the kernel. *) 33 | -------------------------------------------------------------------------------- /src/glob-c.c: -------------------------------------------------------------------------------- 1 | /* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | */ 18 | 19 | #include 20 | 21 | #include 22 | #include 23 | #include 24 | #include 25 | 26 | #include 27 | #include 28 | #include 29 | #include 30 | 31 | /* NB: These flags must appear in the same order as glob.ml */ 32 | static int flags[] = { 33 | GLOB_ERR, 34 | GLOB_MARK, 35 | GLOB_NOSORT, 36 | GLOB_NOCHECK, 37 | GLOB_NOESCAPE, 38 | GLOB_PERIOD, 39 | }; 40 | 41 | value 42 | supermin_glob (value patternv, value flagsv) 43 | { 44 | CAMLparam2 (patternv, flagsv); 45 | CAMLlocal2 (rv, sv); 46 | int f = 0, r; 47 | size_t i; 48 | glob_t g; 49 | 50 | memset (&g, 0, sizeof g); 51 | 52 | /* Convert flags to bitmask. */ 53 | while (flagsv != Val_int (0)) { 54 | f |= flags[Int_val (Field (flagsv, 0))]; 55 | flagsv = Field (flagsv, 1); 56 | } 57 | 58 | r = glob (String_val (patternv), f, NULL, &g); 59 | 60 | if (r == 0 || r == GLOB_NOMATCH) { 61 | if (r == GLOB_NOMATCH) 62 | assert (g.gl_pathc == 0); 63 | 64 | rv = caml_alloc (g.gl_pathc, 0); 65 | for (i = 0; i < g.gl_pathc; ++i) { 66 | sv = caml_copy_string (g.gl_pathv[i]); 67 | Store_field (rv, i, sv); 68 | } 69 | 70 | globfree (&g); 71 | 72 | CAMLreturn (rv); 73 | } 74 | 75 | /* An error occurred. */ 76 | globfree (&g); 77 | 78 | if (r == GLOB_NOSPACE) 79 | caml_raise_out_of_memory (); 80 | else if (r == GLOB_ABORTED) 81 | caml_failwith ("glob: read error"); 82 | else 83 | caml_failwith ("glob: unknown error"); 84 | } 85 | -------------------------------------------------------------------------------- /src/glob.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (* NB: These flags must appear in the same order as fnmatch-c.c *) 20 | type flag = 21 | | GLOB_ERR 22 | | GLOB_MARK 23 | | GLOB_NOSORT 24 | | GLOB_NOCHECK 25 | | GLOB_NOESCAPE 26 | | GLOB_PERIOD 27 | 28 | external glob : string -> flag list -> string array = "supermin_glob" 29 | -------------------------------------------------------------------------------- /src/glob.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | type flag = 20 | | GLOB_ERR 21 | | GLOB_MARK 22 | | GLOB_NOSORT 23 | | GLOB_NOCHECK 24 | | GLOB_NOESCAPE 25 | | GLOB_PERIOD 26 | 27 | val glob : string -> flag list -> string array 28 | -------------------------------------------------------------------------------- /src/librpm-c.c: -------------------------------------------------------------------------------- 1 | /* supermin 5 2 | * Copyright (C) 2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | */ 18 | 19 | #include 20 | 21 | #include 22 | #include 23 | #include 24 | #include 25 | #include 26 | 27 | #include 28 | #include 29 | #include 30 | #include 31 | #include 32 | #include 33 | #include 34 | 35 | #ifdef HAVE_LIBRPM 36 | 37 | #include 38 | #include 39 | #include 40 | #include 41 | #include 42 | 43 | static rpmlogCallback old_log_callback; 44 | 45 | static int 46 | supermin_rpm_log_callback (rpmlogRec rec, rpmlogCallbackData data) 47 | { 48 | fprintf (stderr, "supermin: rpm: lib: %s%s", 49 | rpmlogLevelPrefix (rpmlogRecPriority (rec)), 50 | rpmlogRecMessage (rec)); 51 | return 0; 52 | } 53 | 54 | struct librpm_data 55 | { 56 | rpmts ts; 57 | int debug; 58 | }; 59 | 60 | static void librpm_handle_closed (void) __attribute__((noreturn)); 61 | 62 | static void 63 | librpm_handle_closed (void) 64 | { 65 | caml_failwith ("librpm: function called on a closed handle"); 66 | } 67 | 68 | static void 69 | librpm_raise_multiple_matches (value pkgv, int occurrences) 70 | { 71 | CAMLparam1 (pkgv); 72 | 73 | value args[] = { pkgv, Val_int (occurrences) }; 74 | caml_raise_with_args (*caml_named_value ("librpm_multiple_matches"), 75 | 2, args); 76 | 77 | CAMLnoreturn; 78 | } 79 | 80 | #define Librpm_val(v) (*((struct librpm_data *)Data_custom_val(v))) 81 | #ifndef Val_none 82 | #define Val_none Val_int(0) 83 | #endif 84 | #ifndef Some_val 85 | #define Some_val(v) Field(v,0) 86 | #endif 87 | 88 | static void 89 | librpm_finalize (value rpmv) 90 | { 91 | struct librpm_data data = Librpm_val (rpmv); 92 | 93 | if (data.ts) { 94 | rpmtsFree (data.ts); 95 | 96 | rpmlogSetCallback (old_log_callback, NULL); 97 | } 98 | } 99 | 100 | static struct custom_operations librpm_custom_operations = { 101 | (char *) "librpm_custom_operations", 102 | librpm_finalize, 103 | custom_compare_default, 104 | custom_hash_default, 105 | custom_serialize_default, 106 | custom_deserialize_default 107 | }; 108 | 109 | static value 110 | Val_librpm (struct librpm_data *data) 111 | { 112 | CAMLparam0 (); 113 | CAMLlocal1 (rpmv); 114 | 115 | rpmv = caml_alloc_custom (&librpm_custom_operations, 116 | sizeof (struct librpm_data), 0, 1); 117 | Librpm_val (rpmv) = *data; 118 | CAMLreturn (rpmv); 119 | } 120 | 121 | /* NB: This is a [@@noalloc] call. */ 122 | value 123 | supermin_rpm_is_available (value unit) 124 | { 125 | return Val_true; 126 | } 127 | 128 | value 129 | supermin_rpm_version (value unit) 130 | { 131 | return caml_copy_string (RPMVERSION); 132 | } 133 | 134 | /* NB: This is a [@@noalloc] call. */ 135 | value 136 | supermin_rpm_vercmp (value av, value bv) 137 | { 138 | return Val_int (rpmvercmp (String_val (av), String_val (bv))); 139 | } 140 | 141 | value 142 | supermin_rpm_get_arch (value unit) 143 | { 144 | const char *str; 145 | 146 | rpmGetArchInfo (&str, NULL); 147 | 148 | return caml_copy_string (str); 149 | } 150 | 151 | value 152 | supermin_rpm_open (value debugv) 153 | { 154 | CAMLparam1 (debugv); 155 | CAMLlocal1 (rpmv); 156 | struct librpm_data data; 157 | int res; 158 | rpmlogLvl lvl; 159 | 160 | data.debug = debugv == Val_none ? 0 : Int_val (Some_val (debugv)); 161 | 162 | switch (data.debug) { 163 | case 3: 164 | lvl = RPMLOG_INFO; 165 | break; 166 | case 2: 167 | lvl = RPMLOG_NOTICE; 168 | break; 169 | case 1: 170 | lvl = RPMLOG_WARNING; 171 | break; 172 | case 0: 173 | default: 174 | lvl = RPMLOG_ERR; 175 | break; 176 | } 177 | 178 | rpmSetVerbosity (lvl); 179 | old_log_callback = rpmlogSetCallback (supermin_rpm_log_callback, NULL); 180 | 181 | res = rpmReadConfigFiles (NULL, NULL); 182 | if (res == -1) 183 | caml_failwith ("rpm_open: rpmReadConfigFiles failed"); 184 | 185 | data.ts = rpmtsCreate (); 186 | if (data.ts == NULL) 187 | caml_failwith ("rpm_open: rpmtsCreate failed"); 188 | 189 | rpmv = Val_librpm (&data); 190 | CAMLreturn (rpmv); 191 | } 192 | 193 | value 194 | supermin_rpm_close (value rpmv) 195 | { 196 | CAMLparam1 (rpmv); 197 | 198 | librpm_finalize (rpmv); 199 | 200 | /* So we don't double-free in the finalizer. */ 201 | Librpm_val (rpmv).ts = NULL; 202 | 203 | CAMLreturn (Val_unit); 204 | } 205 | 206 | value 207 | supermin_rpm_installed (value rpmv, value pkgv) 208 | { 209 | CAMLparam2 (rpmv, pkgv); 210 | CAMLlocal2 (rv, v); 211 | struct librpm_data data; 212 | rpmdbMatchIterator iter; 213 | int count, i; 214 | Header h; 215 | rpmtd td; 216 | 217 | data = Librpm_val (rpmv); 218 | if (data.ts == NULL) 219 | librpm_handle_closed (); 220 | 221 | iter = rpmtsInitIterator (data.ts, RPMTAG_NAME, String_val (pkgv), 0); 222 | if (iter == NULL) 223 | caml_raise_not_found (); 224 | 225 | count = rpmdbGetIteratorCount (iter); 226 | if (data.debug >= 2) { 227 | printf ("supermin: rpm: installed: %d occurrences for '%s'\n", 228 | count, String_val (pkgv)); 229 | fflush (stdout); 230 | } 231 | 232 | rv = caml_alloc (count, 0); 233 | i = 0; 234 | td = rpmtdNew (); 235 | 236 | while ((h = rpmdbNextIterator (iter)) != NULL) { 237 | HeaderIterator hi; 238 | uint32_t *val; 239 | bool stored_vals[5] = { false }; 240 | 241 | v = caml_alloc (5, 0); 242 | hi = headerInitIterator (h); 243 | while (headerNext (hi, td) == 1) { 244 | switch (rpmtdTag (td)) { 245 | case RPMTAG_NAME: 246 | Store_field (v, 0, caml_copy_string (rpmtdGetString (td))); 247 | stored_vals[0] = true; 248 | break; 249 | case RPMTAG_EPOCH: 250 | val = rpmtdGetUint32 (td); 251 | Store_field (v, 1, Val_int ((int) *val)); 252 | stored_vals[1] = true; 253 | break; 254 | case RPMTAG_VERSION: 255 | Store_field (v, 2, caml_copy_string (rpmtdGetString (td))); 256 | stored_vals[2] = true; 257 | break; 258 | case RPMTAG_RELEASE: 259 | Store_field (v, 3, caml_copy_string (rpmtdGetString (td))); 260 | stored_vals[3] = true; 261 | break; 262 | case RPMTAG_ARCH: 263 | Store_field (v, 4, caml_copy_string (rpmtdGetString (td))); 264 | stored_vals[4] = true; 265 | break; 266 | } 267 | rpmtdFreeData (td); 268 | } 269 | /* Make sure to properly initialize all the fields of the returned 270 | * rmp_t, even if some tags are missing in the RPM header. 271 | */ 272 | if (!stored_vals[0]) 273 | Store_field (v, 0, caml_copy_string (String_val (pkgv))); 274 | if (!stored_vals[1]) 275 | Store_field (v, 1, Val_int (0)); 276 | if (!stored_vals[2]) 277 | Store_field (v, 2, caml_copy_string ("0")); 278 | if (!stored_vals[3]) 279 | Store_field (v, 3, caml_copy_string ("unknown")); 280 | if (!stored_vals[4]) 281 | Store_field (v, 4, caml_copy_string ("unknown")); 282 | Store_field (rv, i, v); 283 | 284 | headerFreeIterator (hi); 285 | ++i; 286 | } 287 | 288 | rpmtdFree (td); 289 | rpmdbFreeIterator (iter); 290 | 291 | CAMLreturn (rv); 292 | } 293 | 294 | value 295 | supermin_rpm_pkg_requires (value rpmv, value pkgv) 296 | { 297 | CAMLparam2 (rpmv, pkgv); 298 | CAMLlocal1 (rv); 299 | struct librpm_data data; 300 | rpmdbMatchIterator iter; 301 | int count, i; 302 | Header h; 303 | rpmtd td; 304 | 305 | data = Librpm_val (rpmv); 306 | if (data.ts == NULL) 307 | librpm_handle_closed (); 308 | 309 | iter = rpmtsInitIterator (data.ts, RPMDBI_LABEL, String_val (pkgv), 0); 310 | if (iter == NULL) 311 | caml_raise_not_found (); 312 | 313 | count = rpmdbGetIteratorCount (iter); 314 | if (data.debug >= 2) { 315 | printf ("supermin: rpm: pkg_requires: %d occurrences for '%s'\n", 316 | count, String_val (pkgv)); 317 | fflush (stdout); 318 | } 319 | if (count != 1) 320 | librpm_raise_multiple_matches (pkgv, count); 321 | 322 | h = rpmdbNextIterator (iter); 323 | assert (h != NULL); 324 | 325 | td = rpmtdNew (); 326 | i = headerGet (h, RPMTAG_REQUIRENAME, td, HEADERGET_MINMEM); 327 | if (i != 1) 328 | caml_failwith ("rpm_pkg_requires: headerGet failed"); 329 | 330 | rv = caml_alloc (rpmtdCount (td), 0); 331 | for (i = 0; i < rpmtdCount (td); ++i) 332 | Store_field (rv, i, caml_copy_string (rpmtdNextString (td))); 333 | 334 | rpmtdFreeData (td); 335 | rpmtdFree (td); 336 | 337 | rpmdbFreeIterator (iter); 338 | 339 | CAMLreturn (rv); 340 | } 341 | 342 | static rpmdbMatchIterator 343 | createProvidesIterator (rpmts ts, const char *what) 344 | { 345 | rpmdbMatchIterator mi = NULL; 346 | 347 | if (what[0] != '/') { 348 | mi = rpmtsInitIterator(ts, RPMDBI_PROVIDENAME, what, 0); 349 | if (mi != NULL) 350 | return mi; 351 | } 352 | mi = rpmtsInitIterator(ts, RPMDBI_INSTFILENAMES, what, 0); 353 | if (mi != NULL) 354 | return mi; 355 | 356 | mi = rpmtsInitIterator(ts, RPMDBI_PROVIDENAME, what, 0); 357 | 358 | return mi; 359 | } 360 | 361 | value 362 | supermin_rpm_pkg_whatprovides (value rpmv, value pkgv) 363 | { 364 | CAMLparam2 (rpmv, pkgv); 365 | CAMLlocal1 (rv); 366 | struct librpm_data data; 367 | rpmdbMatchIterator iter; 368 | int count, i; 369 | Header h; 370 | rpmtd td; 371 | 372 | data = Librpm_val (rpmv); 373 | if (data.ts == NULL) 374 | librpm_handle_closed (); 375 | 376 | iter = createProvidesIterator (data.ts, String_val (pkgv)); 377 | if (iter == NULL) 378 | caml_raise_not_found (); 379 | 380 | count = rpmdbGetIteratorCount (iter); 381 | if (data.debug >= 2) { 382 | printf ("supermin: rpm: pkg_whatprovides: %d occurrences for '%s'\n", 383 | count, String_val (pkgv)); 384 | fflush (stdout); 385 | } 386 | 387 | rv = caml_alloc (count, 0); 388 | i = 0; 389 | td = rpmtdNew (); 390 | 391 | while ((h = rpmdbNextIterator (iter)) != NULL) { 392 | int ret; 393 | 394 | ret = headerGet (h, RPMTAG_NAME, td, HEADERGET_MINMEM); 395 | if (ret != 1) 396 | caml_failwith ("rpm_pkg_whatprovides: headerGet failed"); 397 | 398 | Store_field (rv, i, caml_copy_string (rpmtdGetString (td))); 399 | 400 | rpmtdFreeData (td); 401 | ++i; 402 | } 403 | 404 | rpmtdFree (td); 405 | rpmdbFreeIterator (iter); 406 | 407 | CAMLreturn (rv); 408 | } 409 | 410 | value 411 | supermin_rpm_pkg_filelist (value rpmv, value pkgv) 412 | { 413 | CAMLparam2 (rpmv, pkgv); 414 | CAMLlocal2 (rv, v); 415 | struct librpm_data data; 416 | rpmdbMatchIterator iter; 417 | int count, i; 418 | Header h; 419 | rpmfi fi; 420 | const rpmfiFlags fiflags = RPMFI_NOHEADER | RPMFI_FLAGS_QUERY | RPMFI_NOFILEDIGESTS; 421 | 422 | data = Librpm_val (rpmv); 423 | if (data.ts == NULL) 424 | librpm_handle_closed (); 425 | 426 | iter = rpmtsInitIterator (data.ts, RPMDBI_LABEL, String_val (pkgv), 0); 427 | if (iter == NULL) 428 | caml_raise_not_found (); 429 | 430 | count = rpmdbGetIteratorCount (iter); 431 | if (data.debug >= 2) { 432 | printf ("supermin: rpm: pkg_filelist: %d occurrences for '%s'\n", 433 | count, String_val (pkgv)); 434 | fflush (stdout); 435 | } 436 | if (count != 1) 437 | librpm_raise_multiple_matches (pkgv, count); 438 | 439 | h = rpmdbNextIterator (iter); 440 | assert (h != NULL); 441 | 442 | fi = rpmfiNew (data.ts, h, RPMTAG_BASENAMES, fiflags); 443 | 444 | count = rpmfiFC (fi); 445 | if (count < 0) 446 | count = 0; 447 | 448 | rv = caml_alloc (count, 0); 449 | i = 0; 450 | 451 | fi = rpmfiInit (fi, 0); 452 | while (rpmfiNext (fi) >= 0) { 453 | const char *fn; 454 | 455 | v = caml_alloc (2, 0); 456 | fn = rpmfiFN(fi); 457 | Store_field (v, 0, caml_copy_string (fn)); 458 | if (rpmfiFFlags (fi) & RPMFILE_CONFIG) 459 | Store_field (v, 1, Val_long (1)); /* FileConfig */ 460 | else 461 | Store_field (v, 1, Val_long (0)); /* FileNormal */ 462 | Store_field (rv, i, v); 463 | ++i; 464 | } 465 | rpmfiFree(fi); 466 | 467 | rpmdbFreeIterator (iter); 468 | 469 | CAMLreturn (rv); 470 | } 471 | 472 | #else 473 | 474 | value 475 | supermin_rpm_is_available (value unit) 476 | { 477 | return Val_false; 478 | } 479 | 480 | value 481 | supermin_rpm_version (value unit) 482 | { 483 | abort (); 484 | } 485 | 486 | value 487 | supermin_rpm_vercmp (value av, value bv) 488 | { 489 | abort (); 490 | } 491 | 492 | value 493 | supermin_rpm_get_arch (value unit) 494 | { 495 | abort (); 496 | } 497 | 498 | value 499 | supermin_rpm_open (value debugv) 500 | { 501 | abort (); 502 | } 503 | 504 | value 505 | supermin_rpm_close (value rpmv) 506 | { 507 | abort (); 508 | } 509 | 510 | value 511 | supermin_rpm_installed (value rpmv, value pkgv) 512 | { 513 | abort (); 514 | } 515 | 516 | value 517 | supermin_rpm_pkg_requires (value rpmv, value pkgv) 518 | { 519 | abort (); 520 | } 521 | 522 | value 523 | supermin_rpm_pkg_whatprovides (value rpmv, value pkgv) 524 | { 525 | abort (); 526 | } 527 | 528 | value 529 | supermin_rpm_pkg_filelist (value rpmv, value pkgv) 530 | { 531 | abort (); 532 | } 533 | 534 | #endif 535 | -------------------------------------------------------------------------------- /src/librpm.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | external rpm_is_available : unit -> bool = "supermin_rpm_is_available" [@@noalloc] 20 | 21 | external rpm_version : unit -> string = "supermin_rpm_version" 22 | external rpm_vercmp : string -> string -> int = "supermin_rpm_vercmp" [@@noalloc] 23 | external rpm_get_arch : unit -> string = "supermin_rpm_get_arch" 24 | 25 | type t 26 | 27 | exception Multiple_matches of string * int 28 | 29 | external rpm_open : ?debug:int -> t = "supermin_rpm_open" 30 | external rpm_close : t -> unit = "supermin_rpm_close" 31 | 32 | type rpm_t = { 33 | name : string; 34 | epoch : int; 35 | version : string; 36 | release : string; 37 | arch : string; 38 | } 39 | 40 | type rpmfile_t = { 41 | filepath : string; 42 | filetype : rpmfiletype_t; 43 | } and rpmfiletype_t = 44 | | FileNormal 45 | | FileConfig 46 | 47 | external rpm_installed : t -> string -> rpm_t array = "supermin_rpm_installed" 48 | external rpm_pkg_requires : t -> string -> string array = "supermin_rpm_pkg_requires" 49 | external rpm_pkg_whatprovides : t -> string -> string array = "supermin_rpm_pkg_whatprovides" 50 | external rpm_pkg_filelist : t -> string -> rpmfile_t array = "supermin_rpm_pkg_filelist" 51 | 52 | let () = 53 | Callback.register_exception "librpm_multiple_matches" (Multiple_matches ("", 0)) 54 | -------------------------------------------------------------------------------- /src/librpm.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** Wrappers around [librpm] functions. *) 20 | 21 | val rpm_is_available : unit -> bool 22 | (** Returns [true] iff librpm is supported. If this returns [false], 23 | then all other functions will abort. *) 24 | 25 | val rpm_version : unit -> string 26 | (** The linked version of librpm. *) 27 | 28 | val rpm_vercmp : string -> string -> int 29 | (** Compare two RPM version strings using RPM version compare rules. *) 30 | 31 | val rpm_get_arch : unit -> string 32 | (** The current main RPM architecture. *) 33 | 34 | type t 35 | (** The librpm handle. *) 36 | 37 | exception Multiple_matches of string * int 38 | 39 | val rpm_open : ?debug:int -> t 40 | (** Open the librpm (transaction set) handle. *) 41 | val rpm_close : t -> unit 42 | (** Explicitly close the handle. The handle can also be closed by 43 | the garbage collector if it becomes unreachable. *) 44 | 45 | type rpm_t = { 46 | name : string; 47 | epoch : int; 48 | version : string; 49 | release : string; 50 | arch : string; 51 | } 52 | 53 | type rpmfile_t = { 54 | filepath : string; 55 | filetype : rpmfiletype_t; 56 | } and rpmfiletype_t = 57 | | FileNormal 58 | | FileConfig 59 | 60 | val rpm_installed : t -> string -> rpm_t array 61 | (** Return the list of packages matching the name 62 | (similar to [rpm -q name]). *) 63 | 64 | val rpm_pkg_requires : t -> string -> string array 65 | (** Return the requires of a package (similar to [rpm -qR]). *) 66 | 67 | val rpm_pkg_whatprovides : t -> string -> string array 68 | (** Return what package(s) provide a particular requirement 69 | (similar to [rpm -q --whatprovides]). *) 70 | 71 | val rpm_pkg_filelist : t -> string -> rpmfile_t array 72 | (** Return the list of files contained in a package, and attributes of 73 | those files (similar to [rpm -ql]). *) 74 | -------------------------------------------------------------------------------- /src/mode_build.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2016 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** Implements the [--build] subcommand. *) 20 | 21 | val build : int -> (bool * Types.format * string * string option * string * bool * int64 option * bool) -> string list -> string -> unit 22 | (** [build debug (args...) inputs outputdir] performs the 23 | [supermin --build] subcommand. *) 24 | 25 | val get_outputs : (bool * Types.format * string * string option * string * bool * int64 option * bool) -> string list -> string list 26 | (** [get_outputs (args...) inputs] gets the potential outputs for the 27 | appliance. *) 28 | -------------------------------------------------------------------------------- /src/mode_prepare.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | open Printf 20 | 21 | open Package_handler 22 | open Utils 23 | 24 | let prepare debug (copy_kernel, format, host_cpu, 25 | packager_config, tmpdir, use_installed, size, 26 | include_packagelist) 27 | inputs outputdir = 28 | if debug >= 1 then 29 | printf "supermin: prepare: %s\n%!" (String.concat " " inputs); 30 | 31 | if inputs = [] then 32 | error "prepare: no input packages specified"; 33 | 34 | let ph = get_package_handler () in 35 | 36 | (* Resolve the package names supplied by the user. Since 37 | * ph_package_of_string returns None if a package is not installed, 38 | * filter_map will return only packages which are installed. 39 | *) 40 | let packages = filter_map ph.ph_package_of_string inputs in 41 | if packages = [] then 42 | error "prepare: none of the packages listed on the command line seem to be installed"; 43 | 44 | if debug >= 1 then ( 45 | printf "supermin: packages specified on the command line:\n"; 46 | List.iter (printf " - %s\n") (List.map ph.ph_package_to_string packages); 47 | flush stdout 48 | ); 49 | 50 | (* Convert input packages to a set. This removes duplicates. *) 51 | let packages = package_set_of_list packages in 52 | 53 | (* Write input packages to the 'packages' file. We don't need to 54 | * write the dependencies because we do dependency resolution at 55 | * build time too. 56 | *) 57 | let () = 58 | let packages = PackageSet.elements packages in 59 | let pkg_names = List.map ph.ph_package_name packages in 60 | let pkg_names = List.sort compare pkg_names in 61 | 62 | let packages_file = outputdir // "packages" in 63 | if debug >= 1 then 64 | printf "supermin: writing %s\n%!" packages_file; 65 | 66 | let chan = open_out packages_file in 67 | List.iter (fprintf chan "%s\n") pkg_names; 68 | close_out chan in 69 | 70 | (* Resolve the dependencies. *) 71 | let packages = get_all_requires packages in 72 | 73 | if debug >= 1 then ( 74 | printf "supermin: after resolving dependencies there are %d packages:\n" 75 | (PackageSet.cardinal packages); 76 | let pkg_names = PackageSet.elements packages in 77 | let pkg_names = List.map ph.ph_package_to_string pkg_names in 78 | let pkg_names = List.sort compare pkg_names in 79 | List.iter (printf " - %s\n") pkg_names; 80 | flush stdout 81 | ); 82 | 83 | (* List the files in each package. *) 84 | let packages = 85 | PackageSet.fold ( 86 | fun pkg pkgs -> 87 | let files = get_files pkg in 88 | (pkg, files) :: pkgs 89 | ) packages [] in 90 | 91 | if debug >= 2 then ( 92 | List.iter ( 93 | fun (pkg, files) -> 94 | printf "supermin: files in '%s':\n" (ph.ph_package_to_string pkg); 95 | List.iter 96 | (fun { ft_path = path; ft_config = config } -> 97 | printf " - %s%s\n" path (if config then " [config]" else "")) 98 | files 99 | ) packages; 100 | flush stdout 101 | ); 102 | 103 | let dir = 104 | if not use_installed then ( 105 | (* For packages that contain any config files, we have to download 106 | * the original package, in order to construct the base image. We 107 | * can skip packages that have no config files. 108 | *) 109 | let dir = tmpdir // "prepare.d" in 110 | Unix.mkdir dir 0o755; 111 | 112 | let () = 113 | let dl_packages = filter_map ( 114 | fun (pkg, files) -> 115 | let has_config_files = 116 | List.exists (fun { ft_config = config } -> config) files in 117 | if has_config_files then Some pkg else None 118 | ) packages in 119 | let dl_packages = package_set_of_list dl_packages in 120 | download_all_packages dl_packages dir in 121 | 122 | dir 123 | ) 124 | else (* --use-installed *) "/" in 125 | 126 | (* Get the list of config files, which are the files we will place 127 | * into base. We have to check the files exist too, since they can 128 | * be missing either from the package or from the filesystem (the 129 | * latter case with --use-installed). 130 | *) 131 | let config_files = 132 | List.map ( 133 | fun (_, files) -> 134 | filter_map ( 135 | function 136 | | { ft_config = true; ft_path = path } -> Some path 137 | | { ft_config = false } -> None 138 | ) files 139 | ) packages in 140 | let config_files = List.flatten config_files in 141 | 142 | let config_files = List.filter ( 143 | fun path -> 144 | try close_in (open_in (dir // path)); true 145 | with Sys_error _ -> false 146 | ) config_files in 147 | 148 | if debug >= 1 then 149 | printf "supermin: there are %d config files\n" 150 | (List.length config_files); 151 | 152 | if config_files <> [] then ( 153 | (* There are config files to copy, so create the list with them, 154 | * and then compress them with tar. 155 | *) 156 | let files_from = 157 | (* Put the list of config files into a file, for tar to read. *) 158 | let files_from = tmpdir // "files-from.txt" in 159 | let chan = open_out files_from in 160 | List.iter (fprintf chan ".%s\n") config_files; (* "./filename" *) 161 | close_out chan; 162 | 163 | files_from in 164 | 165 | (* Write base.tar.gz. *) 166 | let base = outputdir // "base.tar.gz" in 167 | if debug >= 1 then printf "supermin: writing %s\n%!" base; 168 | let cmd = 169 | let mtime = 170 | try sprintf "--mtime=@%s" (quote (Sys.getenv "SOURCE_DATE_EPOCH")) 171 | with Not_found -> "" in 172 | sprintf "tar%s -C %s -z --owner=0 --group=0 %s -cf %s -T %s" 173 | (if debug >=1 then " -v" else "") 174 | (quote dir) mtime (quote base) (quote files_from) in 175 | run_command cmd; 176 | ) 177 | else ( 178 | (* No config files to copy, so do not create base.tar.gz. *) 179 | if debug >= 1 then printf "supermin: not creating base.tar.gz\n%!"; 180 | ) 181 | -------------------------------------------------------------------------------- /src/mode_prepare.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2016 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** Implements the [--prepare] subcommand. *) 20 | 21 | val prepare : int -> (bool * Types.format * string * string option * string * bool * int64 option * bool) -> string list -> string -> unit 22 | (** [prepare debug (args...) inputs outputdir] performs the 23 | [supermin --prepare] subcommand. *) 24 | -------------------------------------------------------------------------------- /src/os_release.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2016 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | open Utils 20 | 21 | let split sep str = 22 | let len = String.length sep in 23 | let seplen = String.length str in 24 | let i = find str sep in 25 | if i = -1 then str, "" 26 | else ( 27 | String.sub str 0 i, String.sub str (i + len) (seplen - i - len) 28 | ) 29 | 30 | type os_release = { 31 | id : string; 32 | } 33 | 34 | let data = ref None 35 | let parsed = ref false 36 | 37 | let rec get_data () = 38 | if !parsed = false then ( 39 | data := parse (); 40 | parsed := true; 41 | ); 42 | 43 | !data 44 | 45 | and parse () = 46 | let file = "/etc/os-release" in 47 | if Sys.file_exists file then ( 48 | let chan = open_in file in 49 | let lines = input_all_lines chan in 50 | close_in chan; 51 | let lines = List.filter ((<>) "") lines in 52 | let lines = List.filter (fun s -> s.[0] <> '#') lines in 53 | 54 | let id = ref "" in 55 | 56 | List.iter ( 57 | fun line -> 58 | let field, value = split "=" line in 59 | let value = 60 | let len = String.length value in 61 | if len > 1 && 62 | ((value.[0] = '"' && value.[len-1] = '"') || 63 | (value.[0] = '\'' && value.[len-1] = '\'')) then 64 | String.sub value 1 (len - 2) 65 | else value in 66 | match field with 67 | | "ID" -> id := value 68 | | _ -> () 69 | ) lines; 70 | 71 | Some { id = !id; } 72 | ) else 73 | None 74 | 75 | let get_id () = 76 | match get_data () with 77 | | None -> "" 78 | | Some d -> d.id 79 | -------------------------------------------------------------------------------- /src/os_release.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2016 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** Handling of /etc/os-release. *) 20 | 21 | val get_id : unit -> string 22 | (** Get the value of the "ID" field from the /etc/os-release file 23 | on the current system. 24 | 25 | An empty string is returned if the file does not exist or cannot 26 | be read. *) 27 | -------------------------------------------------------------------------------- /src/package_handler.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | open Unix 20 | open Unix.LargeFile 21 | open Printf 22 | 23 | open Utils 24 | 25 | type package = int 26 | 27 | module PackageSet = Set.Make ( 28 | struct 29 | type t = package 30 | let compare = compare 31 | end 32 | ) 33 | 34 | let package_set_of_list pkgs = 35 | List.fold_right PackageSet.add pkgs PackageSet.empty 36 | 37 | type settings = { 38 | debug : int; 39 | tmpdir : string; 40 | packager_config : string option; 41 | } 42 | 43 | let no_settings = 44 | { debug = 0; tmpdir = "/nowhere"; packager_config = None; } 45 | 46 | type file = { 47 | ft_path : string; 48 | ft_source_path : string; 49 | ft_config : bool; 50 | } 51 | 52 | let file_source file = 53 | try 54 | if (lstat file.ft_source_path).st_kind = S_REG then 55 | file.ft_source_path 56 | else 57 | file.ft_path 58 | with Unix_error _ -> file.ft_path 59 | 60 | type package_handler = { 61 | ph_detect : unit -> bool; 62 | ph_init : settings -> unit; 63 | ph_fini : unit -> unit; 64 | ph_package_of_string : string -> package option; 65 | ph_package_to_string : package -> string; 66 | ph_package_name : package -> string; 67 | ph_get_package_database_mtime : unit -> float; 68 | ph_get_requires : ph_get_requires; 69 | ph_get_files : ph_get_files; 70 | ph_download_package : ph_download_package; 71 | } 72 | and ph_get_requires = 73 | | PHGetRequires of (package -> PackageSet.t) 74 | | PHGetAllRequires of (PackageSet.t -> PackageSet.t) 75 | and ph_get_files = 76 | | PHGetFiles of (package -> file list) 77 | | PHGetAllFiles of (PackageSet.t -> file list) 78 | and ph_download_package = 79 | | PHDownloadPackage of (package -> string -> unit) 80 | | PHDownloadAllPackages of (PackageSet.t -> string -> unit) 81 | 82 | (* Suggested memoization functions. *) 83 | let get_memo_functions () = 84 | let id = ref 0 in 85 | let h1 = Hashtbl.create 13 and h2 = Hashtbl.create 13 in 86 | let internal_of_pkg pkg = 87 | try Hashtbl.find h1 pkg with Not_found -> assert false 88 | in 89 | let pkg_of_internal internal = 90 | try Hashtbl.find h2 internal 91 | with Not_found -> 92 | let id = incr id; !id in 93 | Hashtbl.add h2 internal id; 94 | Hashtbl.add h1 id internal; 95 | id 96 | in 97 | internal_of_pkg, pkg_of_internal 98 | 99 | let handlers = ref [] 100 | let register_package_handler system packager ph = 101 | handlers := (system, packager, ph) :: !handlers 102 | 103 | let list_package_handlers () = 104 | List.iter ( 105 | fun (system, packager, ph) -> 106 | let detected = ph.ph_detect () in 107 | printf "%s/%s\t%s\n" 108 | system packager (if detected then "detected" else "not-detected") 109 | ) !handlers 110 | 111 | let handler = ref None 112 | 113 | let check_system settings = 114 | try 115 | let (_, _, ph) as h = 116 | List.find (fun (_, _, ph) -> ph.ph_detect ()) !handlers in 117 | handler := Some h; 118 | ph.ph_init settings 119 | with Not_found -> 120 | error "\ 121 | could not detect package manager used by this system or distro. 122 | 123 | If this is a new Linux distro, or not Linux, or a Linux distro that uses 124 | an unusual packaging format then you may need to port supermin. If 125 | you are expecting that supermin should work on this system or distro 126 | then it may be that the package detection code is not working. 127 | 128 | To list which package handlers are compiled into this version of 129 | supermin, do: 130 | 131 | supermin --list-drivers 132 | " 133 | 134 | let rec get_package_handler () = 135 | match !handler with 136 | | Some (_, _, ph) -> ph 137 | | None -> assert false 138 | 139 | let rec get_package_handler_name () = 140 | match !handler with 141 | | Some (system, packager, _) -> sprintf "%s/%s" system packager 142 | | None -> assert false 143 | 144 | let package_handler_shutdown () = 145 | let ph = get_package_handler () in 146 | ph.ph_fini () 147 | 148 | let get_all_requires pkgs = 149 | let ph = get_package_handler () in 150 | match ph.ph_get_requires with 151 | | PHGetRequires f -> 152 | PackageSet.fold (fun pkg -> PackageSet.union (f pkg)) pkgs PackageSet.empty 153 | | PHGetAllRequires f -> f pkgs 154 | 155 | let get_files pkg = 156 | let ph = get_package_handler () in 157 | match ph.ph_get_files with 158 | | PHGetFiles f -> f pkg 159 | | PHGetAllFiles f -> f (PackageSet.singleton pkg) 160 | 161 | let get_all_files pkgs = 162 | let ph = get_package_handler () in 163 | match ph.ph_get_files with 164 | | PHGetFiles f -> 165 | PackageSet.fold (fun pkg xs -> let files = f pkg in files @ xs) pkgs [] 166 | | PHGetAllFiles f -> f pkgs 167 | 168 | let download_all_packages pkgs dir = 169 | let ph = get_package_handler () in 170 | match ph.ph_download_package with 171 | | PHDownloadPackage f -> 172 | PackageSet.iter (fun pkg -> f pkg dir) pkgs 173 | | PHDownloadAllPackages f -> f pkgs dir 174 | -------------------------------------------------------------------------------- /src/package_handler.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** {2 Package handlers.} *) 20 | 21 | type package = int 22 | 23 | module PackageSet : sig 24 | type elt = package 25 | type t 26 | val empty : t 27 | val is_empty : t -> bool 28 | val mem : elt -> t -> bool 29 | val add : elt -> t -> t 30 | val singleton : elt -> t 31 | val remove : elt -> t -> t 32 | val union : t -> t -> t 33 | val inter : t -> t -> t 34 | val diff : t -> t -> t 35 | val compare : t -> t -> int 36 | val equal : t -> t -> bool 37 | val subset : t -> t -> bool 38 | val iter : (elt -> unit) -> t -> unit 39 | val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a 40 | val for_all : (elt -> bool) -> t -> bool 41 | val exists : (elt -> bool) -> t -> bool 42 | val filter : (elt -> bool) -> t -> t 43 | val partition : (elt -> bool) -> t -> t * t 44 | val cardinal : t -> int 45 | val elements : t -> elt list 46 | val min_elt : t -> elt 47 | val max_elt : t -> elt 48 | val choose : t -> elt 49 | val split : elt -> t -> t * bool * t 50 | end 51 | 52 | val package_set_of_list : package list -> PackageSet.t 53 | 54 | (** Package handler settings, passed to [ph_init] function. *) 55 | type settings = { 56 | debug : int; (** Debugging level (-v option). *) 57 | tmpdir : string; 58 | (** A scratch directory, where the package handler may write any 59 | files or directories it needs. The directory exists already, so 60 | does not need to be created. It is deleted automatically when 61 | the program exits. *) 62 | packager_config : string option; 63 | (** The --packager-config command line option, if present. *) 64 | } 65 | 66 | val no_settings : settings 67 | (** An empty settings struct. *) 68 | 69 | (** Files (also directories and other filesystem objects) that are 70 | part of a particular package. Note that the package is always 71 | installed when we query it, so to find out things like the file 72 | type, size and mode you just need to [lstat file.ft_path]. *) 73 | type file = { 74 | ft_path : string; 75 | (** File path. *) 76 | 77 | ft_source_path : string; 78 | (** File's source path. dpkg has a mechanism called "dpkg-divert" 79 | can be used to override a package's version of a file. *) 80 | 81 | ft_config : bool; 82 | (** Flag to indicate this is a configuration file. In some package 83 | managers (RPM) this is stored in package metadata. In others 84 | (dpkg) we guess it based on the filename. *) 85 | } 86 | 87 | val file_source : file -> string 88 | (** Get the source path, taking into account diversions. *) 89 | 90 | (** Package handlers are modules that implement this structure and 91 | call {!register_package_handler}. *) 92 | type package_handler = { 93 | ph_detect : unit -> bool; 94 | (** The package handler should return true if the system uses this 95 | package manager. *) 96 | 97 | ph_init : settings -> unit; 98 | (** This is called when this package handler is chosen and 99 | initializes. The [settings] parameter is a struct of general 100 | settings and configuration. *) 101 | 102 | ph_fini : unit -> unit; 103 | (** This is called at the end of the supermin processing. It can 104 | be used to do teardown operations for the package handler, 105 | when no more package-related operations are going to be done. *) 106 | 107 | ph_package_of_string : string -> package option; 108 | (** Convert a string (from user input) into a package object. If 109 | the package is not installed or the string is otherwise 110 | incorrect this returns [None]. *) 111 | 112 | ph_package_to_string : package -> string; 113 | (** Convert package back to a printable string. {b Only} use this 114 | for debugging and printing errors. Use {!ph_package_name} for a 115 | reproducible name that can be written to packages file. *) 116 | 117 | ph_package_name : package -> string; 118 | (** Return the name of the package, for writing to packagelist. *) 119 | 120 | ph_get_package_database_mtime : unit -> float; 121 | (** Return the last modification time of the package database. 122 | 123 | If not supported, then a package handler can return [0.0] here. 124 | However that will mean that supermin will rebuild the appliance 125 | every time it is run, even when the --if-newer option is 126 | used. *) 127 | 128 | ph_get_requires : ph_get_requires; 129 | (** Given a single installed package or set of packages, return the 130 | names of the installed packages that are dependencies of this 131 | package. 132 | 133 | {b Note} the returned set must also contain the original package. 134 | 135 | The package handler can either implement a function to resolve a 136 | single package name ([PHGetRequires]), or (more efficiently) 137 | resolve a set of packages ([PHGetAllRequires]). *) 138 | 139 | ph_get_files : ph_get_files; 140 | (** Given a single installed package or set of packages, list out 141 | the files in that package (including package management 142 | metadata). 143 | 144 | The package handler can either implement a function to list a 145 | single package ([PHGetFiles]), or (more efficiently) list all 146 | files in a set of packages ([PHGetAllFiles]). *) 147 | 148 | ph_download_package : ph_download_package; 149 | (** [ph_download_package package dir] downloads the named package 150 | from the repository, and unpacks it in the given [dir]. 151 | 152 | The package handler can either implement a function to download 153 | a single package ([PHDownloadPackage]), or (more efficiently) 154 | list all files in a set of packages ([PHDownloadAllPackages]). 155 | 156 | When [--use-installed] option is used, this will not be called. *) 157 | } 158 | and ph_get_requires = 159 | | PHGetRequires of (package -> PackageSet.t) 160 | | PHGetAllRequires of (PackageSet.t -> PackageSet.t) 161 | and ph_get_files = 162 | | PHGetFiles of (package -> file list) 163 | | PHGetAllFiles of (PackageSet.t -> file list) 164 | and ph_download_package = 165 | | PHDownloadPackage of (package -> string -> unit) 166 | | PHDownloadAllPackages of (PackageSet.t -> string -> unit) 167 | 168 | (** Package handlers could use these memoization functions to convert 169 | from the {!package} type to an internal struct and back again, or 170 | they can implement their own. *) 171 | val get_memo_functions : unit -> (package -> 'a) * ('a -> package) 172 | 173 | (** At program start-up, all package handlers register themselves here. *) 174 | val register_package_handler : string -> string -> package_handler -> unit 175 | 176 | val list_package_handlers : unit -> unit 177 | 178 | val check_system : settings -> unit 179 | 180 | val package_handler_shutdown : unit -> unit 181 | 182 | val get_package_handler : unit -> package_handler 183 | 184 | val get_package_handler_name : unit -> string 185 | 186 | val get_all_requires : PackageSet.t -> PackageSet.t 187 | val get_files : package -> file list 188 | val get_all_files : PackageSet.t -> file list 189 | val download_all_packages : PackageSet.t -> string -> unit 190 | -------------------------------------------------------------------------------- /src/ph_dpkg.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | open Unix 20 | open Unix.LargeFile 21 | open Printf 22 | 23 | open Utils 24 | open Package_handler 25 | 26 | let dpkg_detect () = 27 | Config.dpkg <> "no" && 28 | Config.dpkg_deb <> "no" && 29 | Config.dpkg_query <> "no" && 30 | Config.dpkg_divert <> "no" && 31 | Config.apt_get <> "no" && 32 | (List.mem (Os_release.get_id ()) [ "debian"; "ubuntu" ] || 33 | try (stat "/etc/debian_version").st_kind = S_REG with Unix_error _ -> false) 34 | 35 | let dpkg_primary_arch = ref "" 36 | let settings = ref no_settings 37 | 38 | let dpkg_init s = 39 | settings := s; 40 | 41 | let cmd = sprintf "%s --print-architecture" Config.dpkg in 42 | let lines = run_command_get_lines cmd in 43 | match lines with 44 | | [] -> error "dpkg: expecting %s to return some output" cmd 45 | | arch :: _ -> dpkg_primary_arch := arch 46 | 47 | type dpkg_t = { 48 | name : string; 49 | version : string; 50 | arch : string; 51 | } 52 | 53 | (* Memo from package type to internal dpkg_t. *) 54 | let dpkg_of_pkg, pkg_of_dpkg = get_memo_functions () 55 | 56 | let dpkg_packages = Hashtbl.create 13 57 | let dpkg_package_of_string str = 58 | if Hashtbl.length dpkg_packages == 0 then ( 59 | let cmd = 60 | sprintf "%s --show --showformat='${Package} ${Version} ${Architecture} ${Status}\\n'" 61 | Config.dpkg_query in 62 | let lines = run_command_get_lines cmd in 63 | List.iter ( 64 | fun line -> 65 | match string_split " " line with 66 | | [ name; version; arch; _; _; "installed" ] -> 67 | let dpkg = { name = name; version = version; arch = arch } in 68 | Hashtbl.add dpkg_packages name dpkg 69 | | _ -> (); 70 | ) lines 71 | ); 72 | let candidates = Hashtbl.find_all dpkg_packages str in 73 | (* On multiarch setups, only consider the primary architecture *) 74 | try 75 | let pkg = List.find ( 76 | fun cand -> 77 | cand.arch = !dpkg_primary_arch || cand.arch = "all" 78 | ) candidates in 79 | Some (pkg_of_dpkg pkg) 80 | with 81 | Not_found -> None 82 | 83 | let dpkg_package_to_string pkg = 84 | let dpkg = dpkg_of_pkg pkg in 85 | sprintf "%s_%s_%s" dpkg.name dpkg.version dpkg.arch 86 | 87 | let dpkg_package_name pkg = 88 | let dpkg = dpkg_of_pkg pkg in 89 | dpkg.name 90 | 91 | let dpkg_package_name_arch pkg = 92 | let dpkg = dpkg_of_pkg pkg in 93 | sprintf "%s:%s" dpkg.name dpkg.arch 94 | 95 | let dpkg_get_package_database_mtime () = 96 | (lstat "/var/lib/dpkg/status").st_mtime 97 | 98 | let dpkg_get_all_requires pkgs = 99 | let dpkg_requires = Hashtbl.create 13 in 100 | (* Prepare dpkg_requires hashtbl with depends, pre-depends from all 101 | packages. Strip version information and discard alternative 102 | dependencies *) 103 | let cmd = sprintf "\ 104 | %s --show --showformat='${Package} ${Depends} ${Pre-Depends}\n' | \ 105 | sed -e 's/ *([^)]*) */ /g' \ 106 | -e 's/ *, */ /g' \ 107 | -e 's/ *| *[^ ]* */ /g'" 108 | Config.dpkg_query in 109 | let lines = run_command_get_lines cmd in 110 | List.iter ( 111 | fun line -> 112 | match string_split " " line with 113 | | [] -> () 114 | | pkgname :: [] -> () 115 | | pkgname :: deps -> Hashtbl.add dpkg_requires pkgname deps 116 | ) lines; 117 | 118 | let get pkgs = 119 | let pkgnames = List.map dpkg_package_name (PackageSet.elements pkgs) in 120 | let deps = List.map (Hashtbl.find_all dpkg_requires) pkgnames in 121 | let deps = List.flatten (List.flatten deps) in 122 | let deps = filter_map dpkg_package_of_string deps in 123 | PackageSet.union pkgs (package_set_of_list deps) 124 | in 125 | (* The command above only gets one level of dependencies. We need 126 | * to keep iterating until we reach a fixpoint. 127 | *) 128 | let rec loop pkgs = 129 | let pkgs' = get pkgs in 130 | if PackageSet.equal pkgs pkgs' then pkgs 131 | else loop pkgs' 132 | in 133 | loop pkgs 134 | 135 | let dpkg_diversions = Hashtbl.create 13 136 | let dpkg_get_all_files pkgs = 137 | if Hashtbl.length dpkg_diversions = 0 then ( 138 | let cmd = sprintf "%s --list" Config.dpkg_divert in 139 | let lines = run_command_get_lines cmd in 140 | List.iter ( 141 | fun line -> 142 | let items = string_split " " line in 143 | match items with 144 | | ["diversion"; "of"; path; "to"; real_path; "by"; pkg] -> 145 | Hashtbl.add dpkg_diversions path real_path 146 | | _ -> () 147 | ) lines 148 | ); 149 | let cmd = 150 | sprintf "%s --listfiles %s | grep '^/' | grep -v '^/.$' | sort -u" 151 | Config.dpkg_query 152 | (quoted_list (List.map dpkg_package_name_arch 153 | (PackageSet.elements pkgs))) in 154 | let lines = run_command_get_lines cmd in 155 | List.map ( 156 | fun path -> 157 | let config = 158 | try string_prefix "/etc/" path && (lstat path).st_kind = S_REG 159 | with Unix_error _ -> false in 160 | let source_path = 161 | try Hashtbl.find dpkg_diversions path 162 | with Not_found -> path in 163 | { ft_path = path; ft_source_path = source_path; ft_config = config } 164 | ) lines 165 | 166 | let dpkg_download_all_packages pkgs dir = 167 | let tdir = !settings.tmpdir // string_random8 () in 168 | mkdir tdir 0o755; 169 | 170 | let dpkgs = List.map dpkg_package_name (PackageSet.elements pkgs) in 171 | 172 | let cmd = 173 | sprintf "cd %s && %s %s download %s" 174 | (quote tdir) 175 | Config.apt_get 176 | (if !settings.debug >= 1 then "" else " --quiet --quiet") 177 | (quoted_list dpkgs) in 178 | run_command cmd; 179 | 180 | (* Unpack each downloaded package. *) 181 | let cmd = 182 | sprintf " 183 | umask 0000 184 | for f in %s/*.deb; do 185 | %s --fsys-tarfile \"$f\" | (cd %s && tar xf -) 186 | done" 187 | (quote tdir) Config.dpkg_deb (quote dir) in 188 | run_command cmd 189 | 190 | let () = 191 | let ph = { 192 | ph_detect = dpkg_detect; 193 | ph_init = dpkg_init; 194 | ph_fini = (fun () -> ()); 195 | ph_package_of_string = dpkg_package_of_string; 196 | ph_package_to_string = dpkg_package_to_string; 197 | ph_package_name = dpkg_package_name; 198 | ph_get_package_database_mtime = dpkg_get_package_database_mtime; 199 | ph_get_requires = PHGetAllRequires dpkg_get_all_requires; 200 | ph_get_files = PHGetAllFiles dpkg_get_all_files; 201 | ph_download_package = PHDownloadAllPackages dpkg_download_all_packages; 202 | } in 203 | register_package_handler "debian" "dpkg" ph 204 | -------------------------------------------------------------------------------- /src/ph_dpkg.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2016 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** dpkg package handler 20 | 21 | Nothing is exported. This module registers callbacks when it 22 | is loaded. *) 23 | -------------------------------------------------------------------------------- /src/ph_pacman.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | open Unix 20 | open Unix.LargeFile 21 | open Printf 22 | 23 | open Utils 24 | open Package_handler 25 | 26 | let pacman_detect () = 27 | Config.pacman <> "no" && Config.fakeroot <> "no" && 28 | (Os_release.get_id () = "arch" || 29 | Os_release.get_id () = "artix" || 30 | ((stat "/etc/arch-release").st_kind = S_REG && 31 | Config.pacman_g2 = "no")) (* not Frugalware with pacman-g2 *) 32 | 33 | let settings = ref no_settings 34 | 35 | let pacman_init s = settings := s 36 | 37 | type pac_t = { 38 | name : string; 39 | epoch : int; 40 | version : string; 41 | release : string; 42 | arch : string; 43 | } 44 | 45 | (* Memo from package type to internal pac_t. *) 46 | let pac_of_pkg, pkg_of_pac = get_memo_functions () 47 | 48 | (* Memo of pacman_package_of_string. *) 49 | let pach = Hashtbl.create 13 50 | 51 | let pacman_package_of_string str = 52 | (* Parse a package name into the fields like name and version. *) 53 | let parse_pac str = 54 | let cmd = sprintf "%s -Qi %s" Config.pacman (quote str) in 55 | if !settings.debug >= 2 then printf "%s" cmd; 56 | let lines = run_command_get_lines cmd in 57 | 58 | let name = ref "" and evr = ref "" and arch = ref "" in 59 | List.iter ( 60 | fun line -> 61 | let get_value r = 62 | let len = String.length line in 63 | let i = String.index line ':' in 64 | r := String.sub line (i+2) (len-(i+2)) 65 | in 66 | if string_prefix "Name " line then get_value name 67 | else if string_prefix "Version " line then get_value evr 68 | else if string_prefix "Architecture " line then get_value arch 69 | ) lines; 70 | 71 | let name = !name and evr = !evr and arch = !arch in 72 | if name = "" || evr = "" || arch = "" then 73 | error "pacman: Name/Version/Architecture field missing in output of %s" cmd; 74 | 75 | (* Parse epoch:version-release field. *) 76 | let epoch, version, release = 77 | try 78 | let epoch, vr = 79 | try 80 | let i = String.index evr ':' in 81 | int_of_string (String.sub evr 0 i), 82 | String.sub evr (i+1) (String.length evr - (i+1)) 83 | with Not_found -> 0, evr in 84 | let version, release = 85 | match string_split "-" vr with 86 | | [ v; r ] -> v, r 87 | | _ -> assert false in 88 | epoch, version, release 89 | with 90 | Failure _ -> 91 | error "failed to parse epoch:version-release field: %s " evr in 92 | 93 | { name = name; 94 | epoch = epoch; 95 | version = version; 96 | release = release; 97 | arch = arch } 98 | 99 | (* Check if a package is installed. *) 100 | and check_pac_installed name = 101 | let cmd = sprintf "%s -Qq %s >/dev/null 2>&1" Config.pacman (quote name) in 102 | if !settings.debug >= 2 then printf "%s" cmd; 103 | 0 = Sys.command cmd 104 | in 105 | 106 | try 107 | Hashtbl.find pach str 108 | with 109 | Not_found -> 110 | let r = 111 | if check_pac_installed str then ( 112 | let pac = parse_pac str in 113 | Some (pkg_of_pac pac) 114 | ) 115 | else None in 116 | Hashtbl.add pach str r; 117 | r 118 | 119 | let pacman_package_to_string pkg = 120 | let pac = pac_of_pkg pkg in 121 | if pac.epoch = 0 then 122 | sprintf "%s-%s-%s.%s" pac.name pac.version pac.release pac.arch 123 | else 124 | sprintf "%s-%d:%s-%s.%s" 125 | pac.name pac.epoch pac.version pac.release pac.arch 126 | 127 | let pacman_package_name pkg = 128 | let pac = pac_of_pkg pkg in 129 | pac.name 130 | 131 | let pacman_get_package_database_mtime () = 132 | (* This directory changes mtime when packages get installed/reinstalled. 133 | * The directory itself contains several *.db files with different names. 134 | *) 135 | (lstat "/var/lib/pacman/sync/").st_mtime 136 | 137 | let pacman_get_all_requires pkgs = 138 | let cmd = sprintf "\ 139 | for p in %s; do %s -u $p; done | awk '{print $1}' | sort -u 140 | " (quoted_list (List.map pacman_package_name (PackageSet.elements pkgs))) 141 | Config.pactree in 142 | if !settings.debug >= 2 then printf "%s" cmd; 143 | let lines = run_command_get_lines cmd in 144 | let lines = filter_map pacman_package_of_string lines in 145 | PackageSet.union pkgs (package_set_of_list lines) 146 | 147 | let pacman_get_all_files pkgs = 148 | let cmd = 149 | sprintf "%s -Ql %s | awk '{print $2}'" 150 | Config.pacman 151 | (quoted_list (List.map pacman_package_name (PackageSet.elements pkgs))) in 152 | if !settings.debug >= 2 then printf "%s" cmd; 153 | let lines = run_command_get_lines cmd in 154 | List.map ( 155 | fun path -> 156 | (* Remove trailing / from directory names. *) 157 | let path = 158 | let len = String.length path in 159 | if len >= 2 && path.[len-1] = '/' then 160 | String.sub path 0 (len-1) 161 | else 162 | path in 163 | let config = 164 | try string_prefix "/etc/" path && (lstat path).st_kind = S_REG 165 | with Unix_error _ -> false in 166 | { ft_path = path; ft_source_path = path; ft_config = config } 167 | ) lines 168 | 169 | let pacman_download_all_packages pkgs dir = 170 | let tdir = !settings.tmpdir // string_random8 () in 171 | mkdir tdir 0o755; 172 | 173 | let names = List.map pacman_package_name (PackageSet.elements pkgs) in 174 | 175 | (* Because we reuse the same temporary download directory (tdir), this 176 | * only downloads each package once, even though each call to pacman will 177 | * download dependent packages as well. 178 | * 179 | * CacheDir directives must be filtered out to force pacman downloads. 180 | *) 181 | let cmd = sprintf "\ 182 | set -e 183 | umask 0000 184 | cd %s 185 | mkdir -p var/lib/pacman 186 | pacman-conf | grep -v CacheDir > tmp.conf 187 | %s %s%s -Syw --noconfirm --cachedir=$(pwd) --root=$(pwd) %s 188 | " 189 | (quote tdir) 190 | Config.fakeroot Config.pacman 191 | (match !settings.packager_config with 192 | | None -> " --config tmp.conf --dbpath var/lib/pacman" 193 | | Some filename -> " --config " ^ (quote filename)) 194 | (quoted_list names) in 195 | if !settings.debug >= 2 then printf "%s" cmd; 196 | if Sys.command cmd <> 0 then ( 197 | (* The package may not be in the main repos, check the AUR. *) 198 | List.iter ( 199 | fun name -> 200 | let cmd = sprintf "\ 201 | set -e 202 | umask 0000 203 | cd %s 204 | wget %s 205 | tar xf %s 206 | cd %s 207 | %s 208 | mv %s-*.pkg.tar.xz %s 209 | " 210 | (quote tdir) 211 | (quote ("https://aur.archlinux.org/packages/" ^ 212 | (String.sub name 0 2) ^ 213 | "/" ^ name ^ "/" ^ name ^ ".tar.gz")) 214 | (quote (name ^ ".tar.gz")) 215 | (quote name) (* cd *) 216 | Config.makepkg 217 | (quote name) (quote tdir) (* mv *) in 218 | if !settings.debug >= 2 then printf "%s" cmd; 219 | run_command cmd 220 | ) names; 221 | ); 222 | 223 | (* Unpack the downloaded packages. *) 224 | let cmd = 225 | sprintf " 226 | umask 0000 227 | for f in %s/*.pkg.tar.*; do 228 | [[ $f == *.sig ]] && continue 229 | tar -xf \"$f\" -C %s 230 | done 231 | " 232 | (quote tdir) (quote dir) in 233 | if !settings.debug >= 2 then printf "%s" cmd; 234 | run_command cmd 235 | 236 | let () = 237 | let ph = { 238 | ph_detect = pacman_detect; 239 | ph_init = pacman_init; 240 | ph_fini = (fun () -> ()); 241 | ph_package_of_string = pacman_package_of_string; 242 | ph_package_to_string = pacman_package_to_string; 243 | ph_package_name = pacman_package_name; 244 | ph_get_package_database_mtime = pacman_get_package_database_mtime; 245 | ph_get_requires = PHGetAllRequires pacman_get_all_requires; 246 | ph_get_files = PHGetAllFiles pacman_get_all_files; 247 | ph_download_package = PHDownloadAllPackages pacman_download_all_packages; 248 | } in 249 | register_package_handler "arch" "pacman" ph 250 | -------------------------------------------------------------------------------- /src/ph_pacman.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2016 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** pacman package handler. 20 | 21 | Nothing is exported. This module registers callbacks when it 22 | is loaded. *) 23 | -------------------------------------------------------------------------------- /src/ph_rpm.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2016 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** RPM package handler 20 | 21 | Nothing is exported. This module registers callbacks when it 22 | is loaded. *) 23 | -------------------------------------------------------------------------------- /src/realpath-c.c: -------------------------------------------------------------------------------- 1 | /* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | */ 18 | 19 | #include 20 | 21 | #include 22 | #include 23 | #include 24 | 25 | #include 26 | #include 27 | #include 28 | #include 29 | 30 | value 31 | supermin_realpath (value pathv) 32 | { 33 | CAMLparam1 (pathv); 34 | CAMLlocal1 (rv); 35 | char *r; 36 | 37 | r = realpath (String_val (pathv), NULL); 38 | if (r == NULL) 39 | unix_error (errno, (char *) "realpath", pathv); 40 | 41 | rv = caml_copy_string (r); 42 | free (r); 43 | CAMLreturn (rv); 44 | } 45 | -------------------------------------------------------------------------------- /src/realpath.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | external realpath : string -> string = "supermin_realpath" 20 | -------------------------------------------------------------------------------- /src/realpath.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | val realpath : string -> string 20 | -------------------------------------------------------------------------------- /src/supermin-link.sh.in: -------------------------------------------------------------------------------- 1 | # supermin Makefile.am 2 | # @configure_input@ 3 | # (C) Copyright 2009-2014 Red Hat Inc. 4 | # 5 | # This program is free software; you can redistribute it and/or modify 6 | # it under the terms of the GNU General Public License as published by 7 | # the Free Software Foundation; either version 2 of the License, or 8 | # (at your option) any later version. 9 | # 10 | # This program is distributed in the hope that it will be useful, 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | # GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public License 16 | # along with this program; if not, write to the Free Software 17 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | # 19 | # Written by Richard W.M. Jones 20 | 21 | # Hack automake to link 'supermin' binary properly. There is no other 22 | # way to add the -cclib parameter to the end of the command line. 23 | 24 | exec "$@" \ 25 | -linkpkg \ 26 | -runtime-variant _pic \ 27 | -ccopt '@CFLAGS@' \ 28 | -cclib '@LDFLAGS@ @EXT2FS_LIBS@ @COM_ERR_LIBS@ @LIBRPM_LIBS@' 29 | -------------------------------------------------------------------------------- /src/supermin.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2022 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | let stdlib_stderr = stderr 20 | 21 | open Unix 22 | open Unix.LargeFile 23 | open Printf 24 | 25 | open Types 26 | open Utils 27 | open Package_handler 28 | 29 | type mode = Prepare | Build 30 | 31 | let usage_msg = "\ 32 | supermin - tool for creating supermin appliances 33 | Copyright (C) 2009-2014 Red Hat Inc. 34 | 35 | Usage: 36 | 37 | supermin --prepare LIST OF PACKAGES ... 38 | supermin --build INPUT [INPUT ...] 39 | 40 | For full instructions, read the supermin(1) man page. 41 | 42 | Options: 43 | " 44 | 45 | let main () = 46 | Random.self_init (); 47 | 48 | (* Make sure that all the subcommands that we run are printing 49 | * messages in English. Certain package handlers (cough RPM) rely on 50 | * this. 51 | *) 52 | putenv "LANG" "C"; 53 | 54 | (* Refuse to run if TMPDIR is a relative path. See RHBZ#1190754. 55 | * This is untested and will break in some way or another later, so 56 | * better to die now with a meaningful error message. 57 | *) 58 | if try Filename.is_relative (getenv "TMPDIR") with Not_found -> false then 59 | error "error: environment variable $TMPDIR must be an absolute path"; 60 | 61 | (* Create a temporary directory for scratch storage. Because it's 62 | * for large files, use /var/tmp if TMPDIR is not set. 63 | *) 64 | let tmpdir = 65 | let temp_dir = try getenv "TMPDIR" with Not_found -> "/var/tmp" in 66 | let tmpdir = Filename.temp_file ~temp_dir "supermin" ".tmpdir" in 67 | unlink tmpdir; 68 | mkdir tmpdir 0o700; 69 | at_exit 70 | (fun () -> 71 | let cmd = sprintf "rm -rf %s" (quote tmpdir) in 72 | ignore (Sys.command cmd)); 73 | tmpdir in 74 | 75 | let debug, mode, if_newer, inputs, lockfile, outputdir, args = 76 | let display_version () = 77 | printf "supermin %s\n" Config.package_version; 78 | exit 0 79 | in 80 | 81 | let display_drivers () = 82 | list_package_handlers (); 83 | exit 0 84 | in 85 | 86 | let add xs s = xs := s :: !xs in 87 | 88 | let copy_kernel = ref false in 89 | let debug = ref 0 in 90 | let format = ref None in 91 | let host_cpu = ref Config.host_cpu in 92 | let if_newer = ref false in 93 | let lockfile = ref "" in 94 | let mode = ref None in 95 | let outputdir = ref "" in 96 | let packager_config = ref "" in 97 | let use_installed = ref false in 98 | let size = ref None in 99 | let include_packagelist = ref false in 100 | 101 | let set_debug () = incr debug in 102 | 103 | let set_format = function 104 | | "chroot" | "fs" | "filesystem" -> format := Some Chroot 105 | | "ext2" -> format := Some Ext2 106 | | s -> error "unknown --format option (%s)\n" s 107 | in 108 | 109 | let rec set_prepare_mode () = 110 | if !mode <> None then 111 | bad_mode (); 112 | mode := Some Prepare 113 | and set_build_mode () = 114 | if !mode <> None then 115 | bad_mode (); 116 | mode := Some Build 117 | and bad_mode () = 118 | error "you must use --prepare or --build to select the mode" 119 | in 120 | 121 | let set_size arg = size := Some (parse_size arg) in 122 | 123 | let error_supermin_5 () = 124 | error "\ 125 | *** error: This is supermin version 5. 126 | supermin: *** It looks like you are looking for supermin version 4. 127 | 128 | This version of supermin will not work. You need to find the old version 129 | or upgrade to libguestfs >= 1.26. 130 | " 131 | in 132 | 133 | let error_dtb_option _ = 134 | error "\ 135 | *** error: The --dtb option was removed in supermin 5.1.18. 136 | 137 | Normally you can just drop this option and the wildcard following 138 | it. Modern QEMU will generate a correct DTB for the supermin 139 | appliance automatically. 140 | " 141 | in 142 | 143 | let ditto = " -\"-" in 144 | let argspec = Arg.align [ 145 | "--build", Arg.Unit set_build_mode, " Build a full appliance"; 146 | "--copy-kernel", Arg.Set copy_kernel, " Copy kernel instead of symlinking"; 147 | "--dtb", Arg.String error_dtb_option, " Obsolete option, do not use"; 148 | "-f", Arg.String set_format, "chroot|ext2 Set output format"; 149 | "--format", Arg.String set_format, ditto; 150 | "--host-cpu", Arg.Set_string host_cpu, "ARCH Set host CPU architecture"; 151 | "--if-newer", Arg.Set if_newer, " Only build if needed"; 152 | "--include-packagelist", Arg.Set include_packagelist, 153 | " Add a file with the list of packages"; 154 | "--list-drivers", Arg.Unit display_drivers, " Display list of drivers and exit"; 155 | "--lock", Arg.Set_string lockfile, "LOCKFILE Use a lock file"; 156 | "--names", Arg.Unit error_supermin_5, " Give an error for people needing supermin 4"; 157 | "-o", Arg.Set_string outputdir, "OUTPUTDIR Set output directory"; 158 | "--packager-config", Arg.Set_string packager_config, "CONFIGFILE Set packager config file"; 159 | "--prepare", Arg.Unit set_prepare_mode, " Prepare a supermin appliance"; 160 | "--size", Arg.String set_size, " Set the size of the ext2 filesystem"; 161 | "--use-installed", Arg.Set use_installed, " Use installed files instead of accessing network"; 162 | "-v", Arg.Unit set_debug, " Enable debugging messages"; 163 | "--verbose", Arg.Unit set_debug, ditto; 164 | "-V", Arg.Unit display_version, " Display version and exit"; 165 | "--version", Arg.Unit display_version, ditto; 166 | ] in 167 | let inputs = ref [] in 168 | let anon_fun = add inputs in 169 | Arg.parse argspec anon_fun usage_msg; 170 | 171 | let copy_kernel = !copy_kernel in 172 | let debug = !debug in 173 | let host_cpu = !host_cpu in 174 | let if_newer = !if_newer in 175 | let inputs = List.rev !inputs in 176 | let lockfile = match !lockfile with "" -> None | s -> Some s in 177 | let mode = match !mode with Some x -> x | None -> bad_mode (); Prepare in 178 | let outputdir = !outputdir in 179 | let packager_config = 180 | match !packager_config with "" -> None | s -> Some s in 181 | let use_installed = !use_installed in 182 | let size = !size in 183 | let include_packagelist = !include_packagelist in 184 | 185 | let format = 186 | match mode, !format with 187 | | Prepare, Some _ -> 188 | error "cannot use --prepare and --format options together" 189 | | Prepare, None -> Chroot (* doesn't matter, prepare doesn't use this *) 190 | | Build, None -> 191 | error "when using --build, you must specify an output --format" 192 | | Build, Some f -> f in 193 | 194 | if outputdir = "" then 195 | error "supermin: output directory (-o option) must be supplied"; 196 | (* Chop final '/' in output directory (RHBZ#1146753). *) 197 | let outputdir = 198 | let len = String.length outputdir in 199 | if outputdir.[len - 1] == '/' then String.sub outputdir 0 (len - 1) 200 | else outputdir in 201 | 202 | debug, mode, if_newer, inputs, lockfile, outputdir, 203 | (copy_kernel, format, host_cpu, 204 | packager_config, tmpdir, use_installed, size, 205 | include_packagelist) in 206 | 207 | if debug >= 1 then printf "supermin: version: %s\n" Config.package_version; 208 | 209 | (* Try to find out which package management system we're using. 210 | * This fails with an error if one could not be located. 211 | *) 212 | let () = 213 | let (_, _, _, packager_config, tmpdir, _, _, _) = args in 214 | let settings = { 215 | debug = debug; 216 | tmpdir = tmpdir; 217 | packager_config = packager_config; 218 | } in 219 | check_system settings in 220 | 221 | if debug >= 1 then 222 | printf "supermin: package handler: %s\n" (get_package_handler_name ()); 223 | 224 | (* Grab the lock file, is using. Note it is released automatically 225 | * when the program exits for any reason. 226 | *) 227 | (match lockfile with 228 | | None -> () 229 | | Some lockfile -> 230 | if debug >= 1 then printf "supermin: acquiring lock on %s\n%!" lockfile; 231 | let fd = openfile lockfile [O_WRONLY;O_CREAT] 0o644 in 232 | lockf fd F_LOCK 0; 233 | ); 234 | 235 | (* If the --if-newer flag was given, check the dates on input files, 236 | * package database and output directory. If the output directory 237 | * does not exist, or if the dates of either input files or package 238 | * database is newer, then we rebuild. Else we can just exit. 239 | *) 240 | if mode = Build && if_newer then ( 241 | try 242 | let outputs = Mode_build.get_outputs args inputs in 243 | let outputs = List.map ((//) outputdir) outputs in 244 | let outputs = outputdir :: outputs in 245 | let odates = List.map (fun f -> (lstat f).st_mtime) outputs in 246 | if debug >= 2 then ( 247 | List.iter ( 248 | fun f -> 249 | printf "supermin: if-newer: output %s => %.2f\n" 250 | f (lstat f).st_mtime 251 | ) outputs; 252 | ); 253 | let idates = List.map (fun f -> (lstat f).st_mtime) inputs in 254 | if debug >= 2 then ( 255 | List.iter ( 256 | fun f -> 257 | printf "supermin: if-newer: input %s => %.2f\n" 258 | f (lstat f).st_mtime 259 | ) inputs; 260 | ); 261 | let pdate = (get_package_handler ()).ph_get_package_database_mtime () in 262 | if debug >= 2 then ( 263 | printf "supermin: if-newer: package database date: %.2f\n" pdate; 264 | ); 265 | let older = 266 | List.for_all ( 267 | fun idate -> 268 | List.for_all (fun odate -> idate < odate) odates 269 | ) (pdate :: idates) in 270 | if older then ( 271 | if debug >= 1 then 272 | printf "supermin: if-newer: output does not need rebuilding\n%!"; 273 | exit 0 274 | ) 275 | with 276 | Unix_error (ENOENT, _, _) -> () (* just continue *) 277 | ); 278 | 279 | (* Create the output directory nearly atomically. *) 280 | let new_outputdir = outputdir ^ "." ^ string_random8 () in 281 | mkdir new_outputdir 0o755; 282 | at_exit 283 | (fun () -> 284 | let cmd = 285 | sprintf "rm -rf %s 2>/dev/null" (quote new_outputdir) in 286 | ignore (Sys.command cmd)); 287 | 288 | (match mode with 289 | | Prepare -> Mode_prepare.prepare debug args inputs new_outputdir 290 | | Build -> Mode_build.build debug args inputs new_outputdir 291 | ); 292 | 293 | (* Delete the old output directory if it exists. *) 294 | let old_outputdir = 295 | let old_outputdir = outputdir ^ "." ^ string_random8 () in 296 | let cmd = sprintf "mv %s %s 2>/dev/null" 297 | (quote outputdir) (quote old_outputdir) in 298 | if Sys.command cmd == 0 then Some old_outputdir else None in 299 | 300 | if debug >= 1 then 301 | printf "supermin: renaming %s to %s\n%!" new_outputdir outputdir; 302 | rename new_outputdir outputdir; 303 | 304 | match old_outputdir with 305 | | None -> () 306 | | Some old_outputdir -> 307 | let cmd = 308 | (* We have to do the chmod since unwritable directories cannot 309 | * be deleted by 'rm -rf'. Unwritable directories can be created 310 | * by '-f chroot'. 311 | *) 312 | sprintf "( chmod -R +w %s ; rm -rf %s ) 2>/dev/null &" 313 | (quote old_outputdir) (quote old_outputdir) in 314 | ignore (Sys.command cmd); 315 | 316 | package_handler_shutdown () 317 | 318 | let () = 319 | try 320 | Printexc.record_backtrace true; 321 | main () 322 | with 323 | | Unix.Unix_error (code, fname, "") -> (* from a syscall *) 324 | Printexc.print_backtrace stdlib_stderr; 325 | error "error: %s: %s" fname (Unix.error_message code) 326 | | Unix.Unix_error (code, fname, param) -> (* from a syscall *) 327 | Printexc.print_backtrace stdlib_stderr; 328 | error "error: %s: %s: %s" fname (Unix.error_message code) param 329 | | Failure msg -> (* from failwith/failwithf *) 330 | Printexc.print_backtrace stdlib_stderr; 331 | error "failure: %s" msg 332 | | Librpm.Multiple_matches (package, count) -> (* from librpm *) 333 | Printexc.print_backtrace stdlib_stderr; 334 | error "RPM error: %d occurrences for %s" count package 335 | | Invalid_argument msg -> (* probably should never happen *) 336 | Printexc.print_backtrace stdlib_stderr; 337 | error "internal error: invalid argument: %s" msg 338 | | Assert_failure (file, line, char) -> (* should never happen *) 339 | Printexc.print_backtrace stdlib_stderr; 340 | error "internal error: assertion failed at %s, line %d, char %d" 341 | file line char 342 | | Not_found -> (* should never happen *) 343 | Printexc.print_backtrace stdlib_stderr; 344 | error "internal error: Not_found exception was thrown" 345 | | exn -> (* something not matched above *) 346 | Printexc.print_backtrace stdlib_stderr; 347 | error "exception: %s" (Printexc.to_string exn) 348 | -------------------------------------------------------------------------------- /src/types.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | type format = Chroot | Ext2 20 | -------------------------------------------------------------------------------- /src/utils.ml: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | let stdlib_compare = compare 20 | 21 | open Unix 22 | open Unix.LargeFile 23 | open Printf 24 | 25 | let (+^) = Int64.add 26 | let (-^) = Int64.sub 27 | let ( *^ ) = Int64.mul 28 | let (/^) = Int64.div 29 | 30 | let (//) = Filename.concat 31 | let quote = Filename.quote 32 | let quoted_list names = String.concat " " (List.map quote names) 33 | 34 | let error ?(exit_code = 1) fs = 35 | let display str = 36 | prerr_endline (sprintf "supermin: %s" str); 37 | exit exit_code 38 | in 39 | ksprintf display fs 40 | 41 | let dir_exists name = 42 | try (stat name).st_kind = S_DIR 43 | with Unix_error _ -> false 44 | 45 | let uniq ?(cmp = stdlib_compare) xs = 46 | let rec loop acc = function 47 | | [] -> acc 48 | | [x] -> x :: acc 49 | | x :: (y :: _ as xs) when cmp x y = 0 -> 50 | loop acc xs 51 | | x :: (y :: _ as xs) -> 52 | loop (x :: acc) xs 53 | in 54 | List.rev (loop [] xs) 55 | 56 | let sort_uniq ?(cmp = stdlib_compare) xs = 57 | let xs = List.sort cmp xs in 58 | let xs = uniq ~cmp xs in 59 | xs 60 | 61 | let rec input_all_lines chan = 62 | try let line = input_line chan in line :: input_all_lines chan 63 | with End_of_file -> [] 64 | 65 | let run_command_get_lines cmd = 66 | let chan = open_process_in cmd in 67 | let lines = input_all_lines chan in 68 | let stat = close_process_in chan in 69 | (match stat with 70 | | WEXITED 0 -> () 71 | | WEXITED i -> 72 | error ~exit_code:i "command '%s' failed (returned %d), see earlier error messages" 73 | cmd i 74 | | WSIGNALED i -> 75 | error "command '%s' killed by signal %d" cmd i 76 | | WSTOPPED i -> 77 | error "command '%s' stopped by signal %d" cmd i 78 | ); 79 | lines 80 | 81 | let run_command cmd = 82 | if Sys.command cmd <> 0 then 83 | error "%s: command failed, see earlier errors" cmd 84 | 85 | let run_shell code args = 86 | let cmd = sprintf "sh -c %s arg0 %s" 87 | (Filename.quote code) 88 | (String.concat " " (List.map Filename.quote args)) in 89 | if Sys.command cmd <> 0 then 90 | error "external shell program failed, see earlier error messages" 91 | 92 | let rec find s sub = 93 | let len = String.length s in 94 | let sublen = String.length sub in 95 | let rec loop i = 96 | if i <= len-sublen then ( 97 | let rec loop2 j = 98 | if j < sublen then ( 99 | if s.[i+j] = sub.[j] then loop2 (j+1) 100 | else -1 101 | ) else 102 | i (* found *) 103 | in 104 | let r = loop2 0 in 105 | if r = -1 then loop (i+1) else r 106 | ) else 107 | -1 (* not found *) 108 | in 109 | loop 0 110 | 111 | let rec string_split sep str = 112 | let len = String.length str in 113 | let seplen = String.length sep in 114 | let i = find str sep in 115 | if i = -1 then [str] 116 | else ( 117 | let s' = String.sub str 0 i in 118 | let s'' = String.sub str (i+seplen) (len-i-seplen) in 119 | s' :: string_split sep s'' 120 | ) 121 | 122 | let string_prefix p str = 123 | let len = String.length str in 124 | let plen = String.length p in 125 | len >= plen && String.sub str 0 plen = p 126 | 127 | let path_prefix p path = 128 | let len = String.length path in 129 | let plen = String.length p in 130 | path = p || (len > plen && String.sub path 0 (plen+1) = (p ^ "/")) 131 | 132 | let string_random8 = 133 | let chars = "abcdefghijklmnopqrstuvwxyz0123456789" in 134 | fun () -> 135 | String.concat "" ( 136 | List.map ( 137 | fun _ -> 138 | let c = Random.int 36 in 139 | let c = chars.[c] in 140 | String.make 1 c 141 | ) [1;2;3;4;5;6;7;8] 142 | ) 143 | 144 | let rec filter_map f = function 145 | | [] -> [] 146 | | x :: xs -> 147 | let x = f x in 148 | match x with 149 | | None -> filter_map f xs 150 | | Some x -> x :: filter_map f xs 151 | 152 | let rex_numbers = Str.regexp "^\\([0-9]+\\)\\(.*\\)$" 153 | let rex_letters = Str.regexp_case_fold "^\\([a-z]+\\)\\(.*\\)$" 154 | 155 | let rec compare_version v1 v2 = 156 | compare (split_version v1) (split_version v2) 157 | 158 | and split_version = function 159 | | "" -> [] 160 | | str -> 161 | let first, rest = 162 | if Str.string_match rex_numbers str 0 then ( 163 | let n = Str.matched_group 1 str in 164 | let rest = Str.matched_group 2 str in 165 | let n = 166 | try `Number (int_of_string n) 167 | with Failure _ -> `String n in 168 | n, rest 169 | ) 170 | else if Str.string_match rex_letters str 0 then 171 | `String (Str.matched_group 1 str), Str.matched_group 2 str 172 | else ( 173 | let len = String.length str in 174 | `Char str.[0], String.sub str 1 (len-1) 175 | ) in 176 | first :: split_version rest 177 | 178 | (* Parse a size field, eg. "10G". *) 179 | let parse_size = 180 | let const_re = Str.regexp "^\\([.0-9]+\\)\\([bKMG]\\)$" in 181 | fun field -> 182 | let matches rex = Str.string_match rex field 0 in 183 | let sub i = Str.matched_group i field in 184 | let size_scaled f = function 185 | | "b" -> Int64.of_float f 186 | | "K" -> Int64.of_float (f *. 1024.) 187 | | "M" -> Int64.of_float (f *. 1024. *. 1024.) 188 | | "G" -> Int64.of_float (f *. 1024. *. 1024. *. 1024.) 189 | | _ -> assert false 190 | in 191 | 192 | if matches const_re then ( 193 | size_scaled (float_of_string (sub 1)) (sub 2) 194 | ) else ( 195 | error "cannot parse size field '%s'" field 196 | ) 197 | 198 | let isalnum = function 199 | | '0'..'9' | 'a'..'z' | 'A'..'Z' -> true 200 | | _ -> false 201 | -------------------------------------------------------------------------------- /src/utils.mli: -------------------------------------------------------------------------------- 1 | (* supermin 5 2 | * Copyright (C) 2009-2014 Red Hat Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation; either version 2 of the License, or 7 | * (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17 | *) 18 | 19 | (** Utilities. *) 20 | 21 | val (+^) : int64 -> int64 -> int64 22 | val (-^) : int64 -> int64 -> int64 23 | val ( *^ ) : int64 -> int64 -> int64 24 | val (/^) : int64 -> int64 -> int64 25 | (** Int64 operators. *) 26 | 27 | val error : ?exit_code:int -> ('a, unit, string, 'b) format4 -> 'a 28 | (** Standard error function. *) 29 | 30 | val dir_exists : string -> bool 31 | (** Return [true] iff dir exists. *) 32 | 33 | val uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list 34 | (** Uniquify a list (the list must be sorted first). *) 35 | 36 | val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list 37 | (** Sort and uniquify a list. *) 38 | 39 | val input_all_lines : in_channel -> string list 40 | (** Input all lines from a channel, returning a list of lines. *) 41 | 42 | val run_command_get_lines : string -> string list 43 | (** Run the command and read the list of lines that it prints to stdout. *) 44 | 45 | val run_command : string -> unit 46 | (** Run a command using {!Sys.command} and exit if it fails. Be careful 47 | when constructing the command to properly quote any arguments 48 | (using {!Filename.quote}). *) 49 | 50 | val run_shell : string -> string list -> unit 51 | (** [run_shell code args] runs shell [code] with arguments [args]. 52 | This does not return anything, but exits with an error message 53 | if the shell code returns an error. *) 54 | 55 | val (//) : string -> string -> string 56 | (** [x // y] concatenates file paths [x] and [y] into a single path. *) 57 | 58 | val quote : string -> string 59 | (** Quote a string to protect it from shell interpretation. *) 60 | 61 | val quoted_list : string list -> string 62 | (** Quote a list of strings to protect them from shell interpretation. *) 63 | 64 | val find : string -> string -> int 65 | (** [find str sub] searches for [sub] in [str], returning the index 66 | or -1 if not found. *) 67 | 68 | val string_split : string -> string -> string list 69 | (** [string_split sep str] splits [str] at [sep]. *) 70 | 71 | val string_prefix : string -> string -> bool 72 | (** [string_prefix prefix str] returns true iff [str] starts with [prefix]. *) 73 | 74 | val path_prefix : string -> string -> bool 75 | (** [path_prefix prefix path] returns true iff [path] is [prefix] or 76 | [path] starts with [prefix/]. *) 77 | 78 | val string_random8 : unit -> string 79 | (** [string_random8 ()] generates a random printable string of 80 | 8 characters. Note you must call {!Random.self_init} in the 81 | main program if using this. *) 82 | 83 | val filter_map : ('a -> 'b option) -> 'a list -> 'b list 84 | (** map + filter *) 85 | 86 | val compare_version : string -> string -> int 87 | (** Compare two version-like strings. *) 88 | 89 | val parse_size : string -> int64 90 | (** Parse a size field, eg. [10G] *) 91 | 92 | val isalnum : char -> bool 93 | (** Return true iff the character is alphanumeric. *) 94 | -------------------------------------------------------------------------------- /supermin-test-driver: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | # test-driver - basic testsuite driver script. 3 | 4 | scriptversion=2013-07-13.22; # UTC 5 | 6 | # Copyright (C) 2011-2015 Free Software Foundation, Inc. 7 | # 8 | # This program is free software; you can redistribute it and/or modify 9 | # it under the terms of the GNU General Public License as published by 10 | # the Free Software Foundation; either version 2, or (at your option) 11 | # any later version. 12 | # 13 | # This program is distributed in the hope that it will be useful, 14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | # GNU General Public License for more details. 17 | # 18 | # You should have received a copy of the GNU General Public License 19 | # along with this program. If not, see . 20 | 21 | # As a special exception to the GNU General Public License, if you 22 | # distribute this file as part of a program that contains a 23 | # configuration script generated by Autoconf, you may include it under 24 | # the same distribution terms that you use for the rest of that program. 25 | 26 | # This file is maintained in Automake, please report 27 | # bugs to or send patches to 28 | # . 29 | 30 | # Make unconditional expansion of undefined variables an error. This 31 | # helps a lot in preventing typo-related bugs. 32 | set -u 33 | 34 | usage_error () 35 | { 36 | echo "$0: $*" >&2 37 | print_usage >&2 38 | exit 2 39 | } 40 | 41 | print_usage () 42 | { 43 | cat <$log_file 2>&1 109 | estatus=$? 110 | end_t="$(date +'%s')" 111 | 112 | if test $enable_hard_errors = no && test $estatus -eq 99; then 113 | tweaked_estatus=1 114 | else 115 | tweaked_estatus=$estatus 116 | fi 117 | 118 | case $tweaked_estatus:$expect_failure in 119 | 0:yes) col=$red res=XPASS recheck=yes gcopy=yes;; 120 | 0:*) col=$grn res=PASS recheck=no gcopy=no;; 121 | 77:*) col=$blu res=SKIP recheck=no gcopy=yes;; 122 | 99:*) col=$mgn res=ERROR recheck=yes gcopy=yes;; 123 | *:yes) col=$lgn res=XFAIL recheck=no gcopy=yes;; 124 | *:*) col=$red res=FAIL recheck=yes gcopy=yes;; 125 | esac 126 | 127 | # Report the test outcome and exit status in the logs, so that one can 128 | # know whether the test passed or failed simply by looking at the '.log' 129 | # file, without the need of also peaking into the corresponding '.trs' 130 | # file (automake bug#11814). 131 | echo "$res $test_name (exit status: $estatus)" >>$log_file 132 | 133 | # Report outcome to console. 134 | echo "${col}${res}${std}: $test_name" 135 | 136 | # Register the test result, and other relevant metadata. 137 | echo ":test-result: $res" > $trs_file 138 | echo ":global-test-result: $res" >> $trs_file 139 | echo ":recheck: $recheck" >> $trs_file 140 | echo ":copy-in-global-log: $gcopy" >> $trs_file 141 | echo ":guestfs-time: $(($end_t - $start_t))" >> $trs_file 142 | -------------------------------------------------------------------------------- /tests/Makefile.am: -------------------------------------------------------------------------------- 1 | # supermin Makefile.am 2 | # (C) Copyright 2013-2014 Red Hat Inc. 3 | # 4 | # This program is free software; you can redistribute it and/or modify 5 | # it under the terms of the GNU General Public License as published by 6 | # the Free Software Foundation; either version 2 of the License, or 7 | # (at your option) any later version. 8 | # 9 | # This program is distributed in the hope that it will be useful, 10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | # GNU General Public License for more details. 13 | # 14 | # You should have received a copy of the GNU General Public License 15 | # along with this program; if not, write to the Free Software 16 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 17 | # 18 | # Written by Richard W.M. Jones 19 | 20 | LOG_DRIVER = env $(SHELL) $(top_srcdir)/supermin-test-driver 21 | 22 | EXTRA_DIST = \ 23 | automake2junit.ml \ 24 | $(TESTS) 25 | 26 | TESTS = \ 27 | test-basic.sh \ 28 | test-execstack.sh \ 29 | test-build-bash.sh \ 30 | test-binaries-exist.sh \ 31 | test-harder.sh \ 32 | test-if-newer-ext2.sh 33 | 34 | if NETWORK_TESTS 35 | TESTS += \ 36 | test-build-bash-network.sh \ 37 | test-binaries-exist-network.sh \ 38 | test-harder-network.sh 39 | endif 40 | -------------------------------------------------------------------------------- /tests/automake2junit.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/ocamlrun ocaml 2 | 3 | (* Copyright (C) 2010-2014 Red Hat Inc. 4 | * 5 | * This program is free software; you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License as published by 7 | * the Free Software Foundation; either version 2 of the License, or 8 | * (at your option) any later version. 9 | * 10 | * This program is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU General Public License along 16 | * with this program; if not, write to the Free Software Foundation, Inc., 17 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 18 | *) 19 | 20 | open Printf 21 | #load "str.cma" 22 | 23 | type test_result = 24 | | Pass 25 | | Skip 26 | | XFail 27 | | Fail 28 | | XPass 29 | | Error 30 | 31 | let (//) = Filename.concat 32 | 33 | let read_whole_file path = 34 | let buf = Buffer.create 16384 in 35 | let chan = open_in path in 36 | let maxlen = 16384 in 37 | let s = String.create maxlen in 38 | let rec loop () = 39 | let r = input chan s 0 maxlen in 40 | if r > 0 then ( 41 | Buffer.add_substring buf s 0 r; 42 | loop () 43 | ) 44 | in 45 | loop (); 46 | close_in chan; 47 | Buffer.contents buf 48 | 49 | let string_charsplit sep = 50 | Str.split (Str.regexp_string sep) 51 | 52 | let find_trs basedir = 53 | let rec internal_find_trs basedir stack = 54 | let items = Array.to_list (Sys.readdir basedir) in 55 | let items = List.map (fun x -> x, basedir // x) items in 56 | let dirs, files = List.partition ( 57 | fun (_, full_x) -> 58 | try Sys.is_directory full_x 59 | with Sys_error _ -> false 60 | ) items in 61 | let files = List.filter (fun (x, _) -> Filename.check_suffix x ".trs") files in 62 | let files = List.map (fun (_, full_x) -> stack, full_x) files in 63 | let subdirs_files = List.fold_left ( 64 | fun acc (fn, dir) -> 65 | (internal_find_trs dir (fn :: stack)) :: acc 66 | ) [] dirs in 67 | let subdirs_files = List.rev subdirs_files in 68 | List.concat (files :: subdirs_files) 69 | in 70 | internal_find_trs basedir ["tests"] 71 | 72 | let iterate_results trs_files = 73 | let total = ref 0 in 74 | let failures = ref 0 in 75 | let errors = ref 0 in 76 | let skipped = ref 0 in 77 | let total_time = ref 0 in 78 | let buf = Buffer.create 16384 in 79 | let read_trs file = 80 | let log_filename = (Filename.chop_suffix file ".trs") ^ ".log" in 81 | let content = read_whole_file file in 82 | let lines = string_charsplit "\n" content in 83 | let testname = ref (Filename.chop_suffix (Filename.basename file) ".trs") in 84 | let res = ref Pass in 85 | let time = ref 0 in 86 | List.iter ( 87 | fun line -> 88 | let line = string_charsplit " " line in 89 | (match line with 90 | | ":test-result:" :: result :: rest -> 91 | let name = String.concat " " rest in 92 | if String.length name > 0 then testname := name; 93 | res := 94 | (match result with 95 | | "PASS" -> Pass 96 | | "SKIP" -> Skip 97 | | "XFAIL" -> XFail 98 | | "FAIL" -> Fail 99 | | "XPASS" -> XPass 100 | | "ERROR" | _ -> Error); 101 | | ":guestfs-time:" :: delta :: _ -> 102 | time := int_of_string delta 103 | | _ -> () 104 | ); 105 | ) lines; 106 | !testname, !res, !time, log_filename in 107 | List.iter ( 108 | fun (stack, file) -> 109 | let testname, result, time, log_filename = read_trs file in 110 | let log = 111 | match testname with 112 | | _ -> try read_whole_file log_filename with _ -> "" in 113 | let print_tag_with_log tag = 114 | Buffer.add_string buf (sprintf " \n" testname (String.concat "." (List.rev stack)) time); 115 | Buffer.add_string buf (sprintf " <%s>\n" tag log tag); 116 | Buffer.add_string buf (sprintf " \n") 117 | in 118 | (match result with 119 | | Pass -> 120 | print_tag_with_log "system-out" 121 | | Skip -> 122 | skipped := !skipped + 1; 123 | print_tag_with_log "skipped" 124 | | XFail | Fail | XPass -> 125 | failures := !failures + 1; 126 | print_tag_with_log "error" 127 | | Error -> 128 | errors := !errors + 1; 129 | print_tag_with_log "error" 130 | ); 131 | total := !total + 1; 132 | total_time := !total_time + time 133 | ) trs_files; 134 | Buffer.contents buf, !total, !failures, !errors, !skipped, !total_time 135 | 136 | let sort_trs (_, f1) (_, f2) = 137 | compare f1 f2 138 | 139 | let () = 140 | if Array.length Sys.argv < 3 then ( 141 | printf "%s PROJECTNAME BASEDIR\n" Sys.argv.(0); 142 | exit 1 143 | ); 144 | let name = Sys.argv.(1) in 145 | let basedir = Sys.argv.(2) in 146 | let trs_files = List.sort sort_trs (find_trs basedir) in 147 | let buf, total, failures, errors, skipped, time = 148 | iterate_results trs_files in 149 | printf " 150 | 151 | %s 152 | " name total failures skipped errors time buf 153 | -------------------------------------------------------------------------------- /tests/test-basic.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash - 2 | # supermin 3 | # (C) Copyright 2014 Red Hat Inc. 4 | # 5 | # This program is free software; you can redistribute it and/or modify 6 | # it under the terms of the GNU General Public License as published by 7 | # the Free Software Foundation; either version 2 of the License, or 8 | # (at your option) any later version. 9 | # 10 | # This program is distributed in the hope that it will be useful, 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | # GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public License 16 | # along with this program; if not, write to the Free Software 17 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | set -e 20 | 21 | # Test the basic run of supermin 22 | ../src/supermin --help 23 | 24 | # Very simple test for the version string 25 | ../src/supermin --version | grep ^supermin 26 | 27 | # Check that listing drivers work 28 | ../src/supermin --list-drivers 29 | 30 | # Check at least one driver is detected 31 | echo 32 | ../src/supermin --list-drivers | grep -v not-detected 33 | -------------------------------------------------------------------------------- /tests/test-binaries-exist-network.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | USE_NETWORK=1 $srcdir/test-binaries-exist.sh 3 | -------------------------------------------------------------------------------- /tests/test-binaries-exist.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash - 2 | # supermin 3 | # (C) Copyright 2009-2014 Red Hat Inc. 4 | # 5 | # This program is free software; you can redistribute it and/or modify 6 | # it under the terms of the GNU General Public License as published by 7 | # the Free Software Foundation; either version 2 of the License, or 8 | # (at your option) any later version. 9 | # 10 | # This program is distributed in the hope that it will be useful, 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | # GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public License 16 | # along with this program; if not, write to the Free Software 17 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | set -e 20 | 21 | tmpdir=`mktemp -d` 22 | 23 | d1=$tmpdir/d1 24 | d2=$tmpdir/d2 25 | 26 | test "$USE_NETWORK" = 1 || USE_INSTALLED=--use-installed 27 | 28 | # We assume that 'bash' and 'coreutils' package names exist in every distro. 29 | ../src/supermin -v --prepare $USE_INSTALLED bash coreutils -o $d1 30 | 31 | # Build a chroot. 32 | ../src/supermin -v --build -f chroot $d1 -o $d2 33 | 34 | # Check that some well-known binaries were created. 35 | if [ "$(find $d2 -name bash | wc -l)" -lt 1 ]; then 36 | echo "$0: 'bash' binary was not created in chroot" 37 | ls -lR $d2 38 | exit 1 39 | fi 40 | if [ "$(find $d2 -name sync | wc -l)" -lt 1 ]; then 41 | echo "$0: 'sync' binary was not created in chroot" 42 | ls -lR $d2 43 | exit 1 44 | fi 45 | 46 | # Check the mode of the binaries. 47 | if [ "$(find $d2 -name bash -perm -0555 | wc -l)" -lt 1 ]; then 48 | echo "$0: 'bash' binary was not created with the right mode" 49 | ls -lR $d2 50 | exit 1 51 | fi 52 | if [ "$(find $d2 -name sync -perm -0555 | wc -l)" -lt 1 ]; then 53 | echo "$0: 'sync' binary was not created with the right mode" 54 | ls -lR $d2 55 | exit 1 56 | fi 57 | 58 | # These binaries should be runnable (since they are the same as the host). 59 | `find $d2 -name sync ! -path '*/bash/*' | head` 60 | 61 | # Need to chmod $d2 since rm -r can't remove unwritable directories. 62 | chmod -R +w $d2 ||: 63 | rm -rf $tmpdir 64 | -------------------------------------------------------------------------------- /tests/test-build-bash-network.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | USE_NETWORK=1 $srcdir/test-build-bash.sh 4 | -------------------------------------------------------------------------------- /tests/test-build-bash.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash - 2 | # supermin 3 | # (C) Copyright 2009-2014 Red Hat Inc. 4 | # 5 | # This program is free software; you can redistribute it and/or modify 6 | # it under the terms of the GNU General Public License as published by 7 | # the Free Software Foundation; either version 2 of the License, or 8 | # (at your option) any later version. 9 | # 10 | # This program is distributed in the hope that it will be useful, 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | # GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public License 16 | # along with this program; if not, write to the Free Software 17 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | set -e 20 | 21 | # XXX Hack for Arch. 22 | if [ -f /etc/arch-release ]; then 23 | export SUPERMIN_KERNEL=/boot/vmlinuz-linux 24 | fi 25 | 26 | tmpdir=`mktemp -d` 27 | 28 | d1=$tmpdir/d1 29 | d2=$tmpdir/d2 30 | d3=$tmpdir/d3 31 | 32 | test "$USE_NETWORK" = 1 || USE_INSTALLED=--use-installed 33 | 34 | # We assume 'bash' is a package everywhere. 35 | ../src/supermin -v --prepare $USE_INSTALLED bash -o $d1 36 | 37 | arch="$(uname -m)" 38 | 39 | # Check all supermin-helper formats work. 40 | ../src/supermin -v --build -f chroot --host-cpu $arch $d1 -o $d2 41 | ../src/supermin -v --build -f ext2 --host-cpu $arch $d1 -o $d3 42 | 43 | # Need to chmod $d2 since rm -r can't remove unwritable directories. 44 | chmod -R +w $d2 ||: 45 | rm -rf $tmpdir ||: 46 | -------------------------------------------------------------------------------- /tests/test-execstack.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash - 2 | # supermin 3 | # (C) Copyright 2014 Red Hat Inc. 4 | # 5 | # This program is free software; you can redistribute it and/or modify 6 | # it under the terms of the GNU General Public License as published by 7 | # the Free Software Foundation; either version 2 of the License, or 8 | # (at your option) any later version. 9 | # 10 | # This program is distributed in the hope that it will be useful, 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | # GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public License 16 | # along with this program; if not, write to the Free Software 17 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | set -e 20 | 21 | if [ -n "$SKIP_TEST_EXECSTACK" ]; then 22 | echo "$0: test skipped because SKIP_TEST_EXECSTACK is set." 23 | exit 77 24 | fi 25 | 26 | if scanelf --help >/dev/null 2>&1; then 27 | echo "using scanelf" 28 | scanelf -e ../src/supermin 29 | test `scanelf -qe ../src/supermin | wc -l` -eq 0 30 | elif readelf --help >/dev/null 2>&1; then 31 | echo "using readelf" 32 | readelf -lW ../src/supermin | grep GNU_STACK 33 | ! readelf -lW ../src/supermin | grep GNU_STACK | grep 'E ' >/dev/null 2>&1 34 | else 35 | echo "$0: test skipped because none of the following tools is installed: scanelf, readelf" 36 | exit 77 37 | fi 38 | -------------------------------------------------------------------------------- /tests/test-harder-network.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | USE_NETWORK=1 $srcdir/test-harder.sh 4 | -------------------------------------------------------------------------------- /tests/test-harder.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash - 2 | # supermin 3 | # (C) Copyright 2009-2014 Red Hat Inc. 4 | # 5 | # This program is free software; you can redistribute it and/or modify 6 | # it under the terms of the GNU General Public License as published by 7 | # the Free Software Foundation; either version 2 of the License, or 8 | # (at your option) any later version. 9 | # 10 | # This program is distributed in the hope that it will be useful, 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | # GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public License 16 | # along with this program; if not, write to the Free Software 17 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | set -e 20 | 21 | # The idea behind this test is that we have a list of tricky 22 | # packages which are distro-specific, and try to install those 23 | # and check they are installed correctly. 24 | 25 | # NOTE: This test will only work if the $pkgs listed below 26 | # for your distro are installed on the host. SEE LIST BELOW. 27 | 28 | if [ -f /etc/os-release ]; then 29 | distro=$(. /etc/os-release && echo $ID) 30 | case "$distro" in 31 | fedora|rhel|centos) distro=redhat ;; 32 | opensuse*|sled|sles) distro=suse ;; 33 | ubuntu) distro=debian ;; 34 | openmandriva) distro=openmandriva ;; 35 | esac 36 | elif [ -f /etc/arch-release ]; then 37 | distro=arch 38 | elif [ -f /etc/debian_version ]; then 39 | distro=debian 40 | elif [ -f /etc/mageia-release ]; then # before the redhat checks 41 | distro=mageia 42 | elif [ -f /etc/redhat-release ]; then 43 | distro=redhat 44 | elif [ -f /etc/SuSE-release ]; then 45 | distro=suse 46 | elif [ -f /etc/ibm_powerkvm-release ]; then 47 | distro=ibm-powerkvm 48 | else 49 | exit 77 50 | fi 51 | 52 | tmpdir=`mktemp -d` 53 | 54 | d1=$tmpdir/d1 55 | d2=$tmpdir/d2 56 | 57 | case $distro in 58 | arch) 59 | # Choose at least one from AUR. 60 | pkgs="hivex" 61 | ;; 62 | debian) 63 | pkgs="augeas-tools libaugeas0 libhivex0 libhivex-bin" 64 | ;; 65 | mageia) 66 | # Choose rpm because it has an epoch > 0 and is commonly 67 | # installed. (See commit fb40baade8e3441b73ce6fd10a32fbbfe49cc4da) 68 | pkgs="augeas hivex rpm" 69 | ;; 70 | redhat) 71 | # Choose tar because it has an epoch > 0 and is commonly 72 | # installed. (See commit fb40baade8e3441b73ce6fd10a32fbbfe49cc4da) 73 | pkgs="augeas hivex tar" 74 | ;; 75 | suse) 76 | pkgs="augeas hivex tar" 77 | ;; 78 | ibm-powerkvm) 79 | pkgs="augeas hivex tar" 80 | ;; 81 | openmandriva) 82 | pkgs="augeas hivex rpm" 83 | ;; 84 | *) 85 | echo "Unhandled distro '$distro'" 86 | exit 77 87 | ;; 88 | esac 89 | 90 | test "$USE_NETWORK" = 1 || USE_INSTALLED=--use-installed 91 | 92 | ../src/supermin -v --prepare $USE_INSTALLED $pkgs -o $d1 93 | 94 | # Build a chroot. 95 | ../src/supermin -v --build -f chroot $d1 -o $d2 96 | 97 | # Check the result in a distro-specific manner. 98 | case $distro in 99 | arch) 100 | if [ ! -x $d2/usr/bin/hivexget ]; then 101 | echo "$0: $distro: hivexget binary not installed in chroot" 102 | ls -lR $d2 103 | exit 1 104 | fi 105 | if [ "$(find $d2/usr/lib* -name libhivex.so.0 | wc -l)" -lt 1 ]; then 106 | echo "$0: $distro: hivex library not installed in chroot" 107 | ls -lR $d2 108 | exit 1 109 | fi 110 | ;; 111 | debian) 112 | if [ ! -x $d2/usr/bin/augtool ]; then 113 | echo "$0: $distro: augtool binary not installed in chroot" 114 | ls -lR $d2 115 | exit 1 116 | fi 117 | if [ "$(find $d2/usr/lib* -name libaugeas.so.0 | wc -l)" -lt 1 ]; then 118 | echo "$0: $distro: augeas library not installed in chroot" 119 | ls -lR $d2 120 | exit 1 121 | fi 122 | if [ ! -x $d2/usr/bin/hivexget ]; then 123 | echo "$0: $distro: hivexget binary not installed in chroot" 124 | ls -lR $d2 125 | exit 1 126 | fi 127 | if [ "$(find $d2/usr/lib* -name libhivex.so.0 | wc -l)" -lt 1 ]; then 128 | echo "$0: $distro: hivex library not installed in chroot" 129 | ls -lR $d2 130 | exit 1 131 | fi 132 | ;; 133 | mageia) 134 | if [ ! -x $d2/usr/bin/augtool ]; then 135 | echo "$0: $distro: augtool binary not installed in chroot" 136 | ls -lR $d2 137 | exit 1 138 | fi 139 | if [ "$(find $d2/usr/lib* -name libaugeas.so.0 | wc -l)" -lt 1 ]; then 140 | echo "$0: $distro: augeas library not installed in chroot" 141 | ls -lR $d2 142 | exit 1 143 | fi 144 | if [ ! -x $d2/usr/bin/hivexget ]; then 145 | echo "$0: $distro: hivexget binary not installed in chroot" 146 | ls -lR $d2 147 | exit 1 148 | fi 149 | if [ "$(find $d2/usr/lib* -name libhivex.so.0 | wc -l)" -lt 1 ]; then 150 | echo "$0: $distro: hivex library not installed in chroot" 151 | ls -lR $d2 152 | exit 1 153 | fi 154 | if [ ! -x $d2/bin/rpm ]; then 155 | echo "$0: $distro: rpm binary not installed in chroot" 156 | ls -lR $d2 157 | exit 1 158 | fi 159 | ;; 160 | openmandriva) 161 | if [ ! -x $d2/usr/bin/augtool ]; then 162 | echo "$0: $distro: augtool binary not installed in chroot" 163 | ls -lR $d2 164 | exit 1 165 | fi 166 | if [ "$(find $d2/lib* $d2/usr/lib* -name libaugeas.so.0 | wc -l)" -lt 1 ]; then 167 | echo "$0: $distro: augeas library not installed in chroot" 168 | ls -lR $d2 169 | exit 1 170 | fi 171 | if [ ! -x $d2/usr/bin/hivexget ]; then 172 | echo "$0: $distro: hivexget binary not installed in chroot" 173 | ls -lR $d2 174 | exit 1 175 | fi 176 | if [ "$(find $d2/usr/lib* -name libhivex.so.0 | wc -l)" -lt 1 ]; then 177 | echo "$0: $distro: hivex library not installed in chroot" 178 | ls -lR $d2 179 | exit 1 180 | fi 181 | if [ ! -x $d2/bin/rpm ]; then 182 | echo "$0: $distro: rpm binary not installed in chroot" 183 | ls -lR $d2 184 | exit 1 185 | fi 186 | ;; 187 | redhat) 188 | if [ ! -x $d2/usr/bin/augtool ]; then 189 | echo "$0: $distro: augtool binary not installed in chroot" 190 | ls -lR $d2 191 | exit 1 192 | fi 193 | if [ "$(find $d2/usr/lib* -name libaugeas.so.0 | wc -l)" -lt 1 ]; then 194 | echo "$0: $distro: augeas library not installed in chroot" 195 | ls -lR $d2 196 | exit 1 197 | fi 198 | if [ ! -x $d2/usr/bin/hivexget ]; then 199 | echo "$0: $distro: hivexget binary not installed in chroot" 200 | ls -lR $d2 201 | exit 1 202 | fi 203 | if [ "$(find $d2/usr/lib* -name libhivex.so.0 | wc -l)" -lt 1 ]; then 204 | echo "$0: $distro: hivex library not installed in chroot" 205 | ls -lR $d2 206 | exit 1 207 | fi 208 | if [ ! -x $d2/bin/tar ]; then 209 | echo "$0: $distro: tar binary not installed in chroot" 210 | ls -lR $d2 211 | exit 1 212 | fi 213 | ;; 214 | suse) 215 | if [ ! -x $d2/usr/bin/augtool ]; then 216 | echo "$0: $distro: augtool binary not installed in chroot" 217 | ls -lR $d2 218 | exit 1 219 | fi 220 | if [ "$(find $d2/usr/lib* -name libaugeas.so.0 | wc -l)" -lt 1 ]; then 221 | echo "$0: $distro: augeas library not installed in chroot" 222 | ls -lR $d2 223 | exit 1 224 | fi 225 | if [ ! -x $d2/usr/bin/hivexget ]; then 226 | echo "$0: $distro: hivexget binary not installed in chroot" 227 | ls -lR $d2 228 | exit 1 229 | fi 230 | if [ "$(find $d2/usr/lib* -name libhivex.so.0 | wc -l)" -lt 1 ]; then 231 | echo "$0: $distro: hivex library not installed in chroot" 232 | ls -lR $d2 233 | exit 1 234 | fi 235 | if [ ! -x $d2/bin/tar ]; then 236 | echo "$0: $distro: tar binary not installed in chroot" 237 | ls -lR $d2 238 | exit 1 239 | fi 240 | ;; 241 | ibm-powerkvm) 242 | if [ ! -x $d2/usr/bin/augtool ]; then 243 | echo "$0: $distro: augtool binary not installed in chroot" 244 | ls -lR $d2 245 | exit 1 246 | fi 247 | if [ "$(find $d2/usr/lib* -name libaugeas.so.0 | wc -l)" -lt 1 ]; then 248 | echo "$0: $distro: augeas library not installed in chroot" 249 | ls -lR $d2 250 | exit 1 251 | fi 252 | if [ ! -x $d2/usr/bin/hivexget ]; then 253 | echo "$0: $distro: hivexget binary not installed in chroot" 254 | ls -lR $d2 255 | exit 1 256 | fi 257 | if [ "$(find $d2/usr/lib* -name libhivex.so.0 | wc -l)" -lt 1 ]; then 258 | echo "$0: $distro: hivex library not installed in chroot" 259 | ls -lR $d2 260 | exit 1 261 | fi 262 | if [ ! -x $d2/bin/tar ]; then 263 | echo "$0: $distro: tar binary not installed in chroot" 264 | ls -lR $d2 265 | exit 1 266 | fi 267 | ;; 268 | esac 269 | 270 | # Need to chmod $d2 since rm -r can't remove unwritable directories. 271 | chmod -R +w $d2 ||: 272 | rm -rf $tmpdir 273 | -------------------------------------------------------------------------------- /tests/test-if-newer-ext2.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash - 2 | # supermin 3 | # (C) Copyright 2009-2020 Red Hat Inc. 4 | # 5 | # This program is free software; you can redistribute it and/or modify 6 | # it under the terms of the GNU General Public License as published by 7 | # the Free Software Foundation; either version 2 of the License, or 8 | # (at your option) any later version. 9 | # 10 | # This program is distributed in the hope that it will be useful, 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | # GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public License 16 | # along with this program; if not, write to the Free Software 17 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | set -e 20 | set -x 21 | 22 | # XXX Hack for Arch. 23 | if [ -f /etc/arch-release ]; then 24 | export SUPERMIN_KERNEL=/boot/vmlinuz-linux 25 | fi 26 | 27 | tmpdir=`mktemp -d` 28 | 29 | d1=$tmpdir/d1 30 | d2=$tmpdir/d2 31 | 32 | # We assume 'bash' is a package everywhere. 33 | ../src/supermin -v --prepare --use-installed bash -o $d1 34 | 35 | run_supermin () 36 | { 37 | ../src/supermin -v --build -f ext2 --if-newer $d1 -o $d2 38 | } 39 | 40 | # Build the appliance the first time, which will work. 41 | run_supermin 42 | 43 | # No changes, hence nothing to do. 44 | run_supermin > test-if-newer-ext2.out 45 | cat test-if-newer-ext2.out 46 | grep 'if-newer: output does not need rebuilding' test-if-newer-ext2.out 47 | rm test-if-newer-ext2.out 48 | 49 | # Try removing any of the files, and check that supermin will detect that. 50 | ext2_files="kernel initrd root" 51 | for ext2_file in $ext2_files 52 | do 53 | rm $d2/$ext2_file 54 | run_supermin 55 | for ext2_file in $ext2_files 56 | do 57 | test -e $d2/$ext2_file 58 | done 59 | done 60 | 61 | rm -rf $tmpdir ||: 62 | --------------------------------------------------------------------------------