diff --git a/.dockerignore b/.dockerignore new file mode 100644 index 0000000..7a05d51 --- /dev/null +++ b/.dockerignore @@ -0,0 +1,39 @@ +# Dependencies +node_modules/ +tools/node_modules/ + +# Version control +.git/ +.gitignore +.gitattributes + +# Documentation +*.md +README* +LICENSE + +# Test artifacts and scripts +test-*.sh +test-output/ + +# Build artifacts +*.o +*.a +*.wasm +*.wasm.map + +# Logs +*.log + +# IDE +.vscode/ +.idea/ +*.swp +*.swo + +# OS +.DS_Store +Thumbs.db + +# Pi agent config +.pi/ diff --git a/.github/actions/setup-binaryen/action.yml b/.github/actions/setup-binaryen/action.yml index e483d5b..561d300 100644 --- a/.github/actions/setup-binaryen/action.yml +++ b/.github/actions/setup-binaryen/action.yml @@ -1,25 +1,25 @@ -name: 'Setup Binaryen' -description: 'Install Binaryen WebAssembly toolchain' +name: "Setup Binaryen" +description: "Install Binaryen WebAssembly toolchain" inputs: version: - description: 'Binaryen version to install' + description: "Binaryen version to install" required: false - default: '124' + default: "124" install-path: - description: 'Directory to install Binaryen to' + description: "Directory to install Binaryen to" required: false - default: '/opt/binaryen' + default: "/opt/binaryen" outputs: binaryen-path: - description: 'Path to the installed Binaryen' + description: "Path to the installed Binaryen" value: ${{ steps.install-unix.outputs.binaryen-path || steps.install-windows.outputs.binaryen-path }} binaryen-version: - description: 'Version of Binaryen that was installed' + description: "Version of Binaryen that was installed" value: ${{ inputs.version }} runs: - using: 'composite' + using: "composite" steps: - name: Detect platform id: platform @@ -128,4 +128,4 @@ runs: shell: pwsh run: | & wasm-opt --version - Write-Host "Binaryen installation verified" \ No newline at end of file + Write-Host "Binaryen installation verified" diff --git a/.github/actions/setup-wabt/action.yml b/.github/actions/setup-wabt/action.yml index ae92975..6e632c7 100644 --- a/.github/actions/setup-wabt/action.yml +++ b/.github/actions/setup-wabt/action.yml @@ -1,25 +1,25 @@ -name: 'Setup WABT' -description: 'Install WebAssembly Binary Toolkit (WABT)' +name: "Setup WABT" +description: "Install WebAssembly Binary Toolkit (WABT)" inputs: version: - description: 'WABT version to install' + description: "WABT version to install" required: false - default: '1.0.39' + default: "1.0.39" install-path: - description: 'Directory to install WABT to' + description: "Directory to install WABT to" required: false - default: '/opt/wabt' + default: "/opt/wabt" outputs: wabt-path: - description: 'Path to the installed WABT' + description: "Path to the installed WABT" value: ${{ steps.install-unix.outputs.wabt-path || steps.install-windows.outputs.wabt-path }} wabt-version: - description: 'Version of WABT that was installed' + description: "Version of WABT that was installed" value: ${{ inputs.version }} runs: - using: 'composite' + using: "composite" steps: - name: Detect platform id: platform @@ -120,4 +120,4 @@ runs: shell: pwsh run: | & wasm-objdump --version - Write-Host "WABT installation verified" \ No newline at end of file + Write-Host "WABT installation verified" diff --git a/.github/workflows/nodefs.yml b/.github/workflows/nodefs.yml index 27a233d..93b890e 100644 --- a/.github/workflows/nodefs.yml +++ b/.github/workflows/nodefs.yml @@ -6,12 +6,11 @@ env: EMSCRIPTEN_VERSION: 3.1.73 jobs: - perlemscripten: runs-on: ubuntu-24.04 steps: - uses: actions/checkout@v4 - + - name: Setup Emscripten uses: mymindstorm/setup-emsdk@v13 with: @@ -41,7 +40,7 @@ jobs: # Archive::Zip Compress::Raw::Lzma Compress::Zlib Digest::MD5 Digest::SHA \ # IO::Compress::Brotli IO::Compress::RawDeflate IO::Uncompress::Brotli \ # IO::Uncompress::RawInflate POSIX::strptime Time::HiRes - + - name: Heredoc run: | cat <<'EOF' > hintfile_wasm.sh @@ -116,26 +115,26 @@ jobs: # Configure apparently changes "-s ASSERTIONS=2 -s STACK_OVERFLOW_CHECK=2" to "-s -s" when converting ccflags to cppflags # this is the current hack/workaround: copy cppflags from config.sh and fix it (TODO Later: better way would be to patch Configure) cppflags='-lm -s ERROR_ON_UNDEFINED_SYMBOLS=0 -D_GNU_SOURCE -D_POSIX_C_SOURCE -DSTANDARD_C -DPERL_USE_SAFE_PUTENV -DNO_MATHOMS -Wno-null-pointer-arithmetic -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include' - + EOF - name: Install Perl static wasm shell: bash run: | - + mkdir wasm && curl -L $URLPERL | tar -xzf - --strip-components=1 --directory=wasm - + cp hintfile_wasm.sh wasm/hints/emscripten.sh - + cd wasm # Ensure the correct directories are created mkdir -p ./prefix/lib/perl5/site_perl/5.40.0/wasm - + # Copy the required files cp -rv ../native/prefix/lib/perl5/site_perl/5.40.0/Image ./prefix/lib/perl5/site_perl/5.40.0/wasm/ cp -rv ../native/prefix/lib/perl5/site_perl/5.40.0/File ./prefix/lib/perl5/site_perl/5.40.0/wasm/ - + emconfigure sh ./Configure -sde -Dinc_version_list=none -Ddlsrc=none -Dloclibpth='' -Dglibpth='' -Dlns='/bin/ln' -Dman1dir=none -Dman3dir=none -Dosname="emscripten" -Darchname="wasm" -Dosvers="2.0.5" -Dmyhostname='localhost' -Dmydomain='.local' -Dperladmin=root -Dcc=emcc -Dld=emcc -Dar=$(which emar) -Dranlib=$(which emranlib) -Doptimize="-O2" -Dlibs='-lm' -Dhintfile=emscripten -Dsysroot=$(dirname $(which emcc))/system -Dhostperl=$PWD/../native/miniperl -Dhostgenerate=$PWD/../native/generate_uudmap -Dprefix=$PWD/prefix -Dstatic_ext="mro Devel/Peek File/DosGlob File/Glob Sys/Syslog Sys/Hostname PerlIO/via PerlIO/mmap PerlIO/encoding B attributes Unicode/Normalize Unicode/Collate threads threads/shared IPC/SysV re Digest/MD5 Digest/SHA SDBM_File Math/BigInt/FastCalc Data/Dumper I18N/Langinfo Time/HiRes Time/Piece IO Socket Hash/Util/FieldHash Hash/Util Filter/Util/Call POSIX Encode/Unicode Encode Encode/JP Encode/KR Encode/EBCDIC Encode/CN Encode/Symbol Encode/Byte Encode/TW Compress/Raw/Zlib Compress/Raw/Bzip2 MIME/Base64 Cwd Storable List/Util Fcntl Opcode" - + ln -s $PWD/pod/perldelta.pod .; ln $PWD/README.* .. emmake make utilities PERL="$PWD/../native/miniperl" emmake make RUN_PERL="$PWD/../native/miniperl -Ilib -I." diff --git a/.github/workflows/zeroperl-release.yml b/.github/workflows/zeroperl-release.yml new file mode 100644 index 0000000..22fc824 --- /dev/null +++ b/.github/workflows/zeroperl-release.yml @@ -0,0 +1,208 @@ +name: zeroperl Release + +on: + workflow_dispatch: + inputs: + tag: + description: "Release tag (e.g. v0.1.0). Leave empty to skip release creation." + required: false + type: string + default: "" + perl-version-legacy: + description: "Legacy Perl version" + required: false + default: "5.16.3" + perl-version-latest: + description: "Latest Perl version" + required: false + default: "5.42.2" + exiftool-version: + description: "ExifTool version" + required: false + default: "13.55" + +jobs: + build: + runs-on: ubuntu-latest + strategy: + fail-fast: false + matrix: + include: + - name: exiftool-5.16.3 + perl-version: ${{ inputs.perl-version-legacy }} + shrink-mode: full + embed-prefix: true + build-exiftool: true + - name: exiftool-5.42.2 + perl-version: ${{ inputs.perl-version-latest }} + shrink-mode: full + embed-prefix: true + build-exiftool: true + - name: perl-only-5.16.3 + perl-version: ${{ inputs.perl-version-legacy }} + shrink-mode: off + embed-prefix: true + build-exiftool: false + - name: perl-only-5.42.2 + perl-version: ${{ inputs.perl-version-latest }} + shrink-mode: off + embed-prefix: true + build-exiftool: false + + steps: + - name: Check out code + uses: actions/checkout@v7 + with: + submodules: recursive + + - name: Install verifier dependencies + run: npm --prefix tools ci + + - name: Build zeroperl (${{ matrix.name }}) + run: | + SFS_COMPRESS="false" + if [ "${{ matrix.shrink-mode }}" = "full" ]; then + SFS_COMPRESS="true" + fi + + docker build \ + --build-arg PERL_VERSION=${{ matrix.perl-version }} \ + --build-arg EXIFTOOL_VERSION=${{ inputs.exiftool-version }} \ + --build-arg BUILD_EXIFTOOL=${{ matrix.build-exiftool }} \ + --build-arg TRIM=true \ + --build-arg ZEROPERL_SHRINK=${{ matrix.shrink-mode }} \ + --build-arg ZEROPERL_SFS_COMPRESS=${SFS_COMPRESS} \ + --build-arg ZEROPERL_EMBED_PREFIX=${{ matrix.embed-prefix }} \ + -t zeroperl:${{ matrix.name }} . + + - name: Build wasi-perl stage (${{ matrix.name }}) + run: | + SFS_COMPRESS="false" + if [ "${{ matrix.shrink-mode }}" = "full" ]; then + SFS_COMPRESS="true" + fi + + docker build \ + --target wasi-perl \ + --build-arg PERL_VERSION=${{ matrix.perl-version }} \ + --build-arg EXIFTOOL_VERSION=${{ inputs.exiftool-version }} \ + --build-arg BUILD_EXIFTOOL=${{ matrix.build-exiftool }} \ + --build-arg TRIM=true \ + --build-arg ZEROPERL_SHRINK=${{ matrix.shrink-mode }} \ + --build-arg ZEROPERL_SFS_COMPRESS=${SFS_COMPRESS} \ + --build-arg ZEROPERL_EMBED_PREFIX=${{ matrix.embed-prefix }} \ + -t zeroperl:${{ matrix.name }}-wasi . + + - name: ExifTool smoke (${{ matrix.name }}) + if: ${{ matrix.build-exiftool == true }} + run: | + docker run --rm zeroperl:${{ matrix.name }}-wasi \ + sh -lc '/build/native/prefix/bin/perl /build/repo/exiftool.min.pl -ver' + + - name: Extract wasi gen artifacts (${{ matrix.name }}) + if: ${{ matrix.shrink-mode != 'off' }} + run: | + mkdir -p /tmp/wasi-gen/${{ matrix.name }} + for file in traced-files.txt xs-static-ext.txt warmup-inc.txt wasm-missing-paths.txt; do + docker run --rm zeroperl:${{ matrix.name }}-wasi \ + sh -lc "cat /build/repo/gen/$file" > "/tmp/wasi-gen/${{ matrix.name }}/$file" + done + + - name: Shrink manifest determinism (${{ matrix.name }}) + if: ${{ matrix.shrink-mode != 'off' }} + run: | + SFS_COMPRESS="true" + docker build \ + --target wasi-perl \ + --build-arg PERL_VERSION=${{ matrix.perl-version }} \ + --build-arg EXIFTOOL_VERSION=${{ inputs.exiftool-version }} \ + --build-arg BUILD_EXIFTOOL=${{ matrix.build-exiftool }} \ + --build-arg TRIM=true \ + --build-arg ZEROPERL_SHRINK=${{ matrix.shrink-mode }} \ + --build-arg ZEROPERL_SFS_COMPRESS=${SFS_COMPRESS} \ + --build-arg ZEROPERL_EMBED_PREFIX=${{ matrix.embed-prefix }} \ + -t zeroperl:${{ matrix.name }}-wasi-determinism . + + manifest_cmd='for f in /build/repo/gen/traced-files.txt /build/repo/gen/xs-static-ext.txt /build/repo/gen/hints-static-ext.fragment /build/repo/gen/wasm-auto-libs.txt /build/repo/gen/xs_init.inc; do if [ -f "$f" ]; then sha256sum "$f"; else echo "MISSING $f"; fi; done' + docker run --rm zeroperl:${{ matrix.name }}-wasi sh -lc "$manifest_cmd" | sort > /tmp/manifest-${{ matrix.name }}-a.txt + docker run --rm zeroperl:${{ matrix.name }}-wasi-determinism sh -lc "$manifest_cmd" | sort > /tmp/manifest-${{ matrix.name }}-b.txt + diff -u /tmp/manifest-${{ matrix.name }}-a.txt /tmp/manifest-${{ matrix.name }}-b.txt + + - name: Extract artifacts (${{ matrix.name }}) + run: | + mkdir -p output/${{ matrix.name }} + docker run --rm -v $PWD/output:/output zeroperl:${{ matrix.name }} \ + cp -r /artifacts/. /output/${{ matrix.name }}/ + ls -la output/${{ matrix.name }}/ + + - name: Embedded @INC verifier (${{ matrix.name }}) + if: ${{ matrix.embed-prefix == true && matrix.build-exiftool == true }} + run: node tools/verify-embedded-inc.mjs output/${{ matrix.name }}/zeroperl.wasm + + - name: WASM runtime smoke (${{ matrix.name }}) + if: ${{ matrix.build-exiftool == true && matrix.embed-prefix == true }} + run: node tools/wasm-smoke.mjs output/${{ matrix.name }}/zeroperl.wasm output/${{ matrix.name }}/exiftool.min.pl + + - name: Upload WASM artifacts (${{ matrix.name }}) + uses: actions/upload-artifact@v7 + with: + name: wasm-${{ matrix.name }} + path: | + output/${{ matrix.name }}/zeroperl.wasm + output/${{ matrix.name }}/zeroperl_reactor.wasm + output/${{ matrix.name }}/config.h + if-no-files-found: error + + - name: Upload Perl prefix (${{ matrix.name }}) + uses: actions/upload-artifact@v7 + with: + name: prefix-${{ matrix.name }} + path: output/${{ matrix.name }}/perl-wasi-prefix + + - name: Upload ExifTool (${{ matrix.name }}) + if: ${{ matrix.build-exiftool == true }} + uses: actions/upload-artifact@v7 + with: + name: exiftool-${{ matrix.name }} + path: output/${{ matrix.name }}/exiftool.min.pl + + publish: + needs: build + runs-on: ubuntu-latest + if: ${{ inputs.tag != '' }} + permissions: + contents: write + + steps: + - name: Download all artifacts + uses: actions/download-artifact@v8 + with: + path: release-assets + merge-multiple: false + + - name: Prepare release assets + run: | + mkdir -p assets + for dir in release-assets/wasm-*/; do + name=$(basename "$dir" | sed 's/^wasm-//') + if [ -f "$dir/zeroperl.wasm" ]; then + cp "$dir/zeroperl.wasm" "assets/${name}.wasm" + fi + for f in zeroperl_reactor.wasm config.h; do + if [ -f "$dir/$f" ]; then + cp "$dir/$f" "assets/${name}_${f}" + fi + done + done + echo "=== Release assets ===" + ls -lh assets/ + + - name: Create GitHub release + uses: softprops/action-gh-release@v3 + with: + tag_name: ${{ inputs.tag }} + name: Release ${{ inputs.tag }} + draft: false + files: assets/* + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/zeroperl.yml b/.github/workflows/zeroperl.yml deleted file mode 100644 index dcfcd63..0000000 --- a/.github/workflows/zeroperl.yml +++ /dev/null @@ -1,84 +0,0 @@ -name: zeroperl - -on: - workflow_dispatch: - inputs: - perl-version: - description: "Perl version to build" - required: false - default: "5.42.0" - exiftool-version: - description: "Version of ExifTool to build" - required: false - default: "13.42" - build-exiftool: - description: "Whether to build ExifTool" - required: false - type: boolean - default: true - stack-size: - description: "WASM stack size (in bytes)" - required: false - default: "8388608" - initial-memory: - description: "WASM initial memory (in bytes)" - required: false - default: "33554432" - trim: - description: "Trim the prefix" - required: false - type: boolean - default: true - asyncify: - description: "Asyncify imports" - required: false - type: boolean - default: true - -jobs: - build: - runs-on: ubuntu-latest - - steps: - - name: Check out code - uses: actions/checkout@v4 - - - name: Build zeroperl - run: | - docker build \ - --build-arg PERL_VERSION=${{ inputs.perl-version }} \ - --build-arg EXIFTOOL_VERSION=${{ inputs.exiftool-version }} \ - --build-arg BUILD_EXIFTOOL=${{ inputs.build-exiftool }} \ - --build-arg STACK_SIZE=${{ inputs.stack-size }} \ - --build-arg INITIAL_MEMORY=${{ inputs.initial-memory }} \ - --build-arg TRIM=${{ inputs.trim }} \ - --build-arg ASYNCIFY=${{ inputs.asyncify }} \ - -t zeroperl:latest . - - - name: Extract artifacts - run: | - mkdir -p output - docker run --rm -v $PWD/output:/output zeroperl:latest cp -r /artifacts/. /output/ - ls -la output/ - - - name: Upload WASM artifacts - uses: actions/upload-artifact@v4 - with: - name: zeroperl-wasm - path: | - output/zeroperl.wasm - output/zeroperl_reactor.wasm - output/config.h - - - name: Upload Perl prefix - uses: actions/upload-artifact@v4 - with: - name: perl-wasi-prefix - path: output/perl-wasi-prefix - - - name: Upload ExifTool - if: ${{ inputs.build-exiftool == true }} - uses: actions/upload-artifact@v4 - with: - name: exiftool-stripped - path: output/exiftool.min.pl diff --git a/.gitignore b/.gitignore index 9374996..b930837 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,21 @@ -output/ -sandbox/ -gen/ *.o *.a *.wasm .DS_Store +package.json +package-lock.json +eslint.config.mjs +AGENTS.md +lint.sh* +.clang-tidy +gen/ +output*/ +node_modules/ +go-exiftool-wasm/ +test-output/ +output/ +/.pi*/ +test-output*/ +.vscode/ +.test-matrix.pid +tmp/ diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..723b242 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "zeroperl-ts"] + path = zeroperl-ts + url = https://github.com/lbe/zeroperl-ts.git diff --git a/.vscode/settings.json b/.vscode/settings.json deleted file mode 100644 index 8d187be..0000000 --- a/.vscode/settings.json +++ /dev/null @@ -1,14 +0,0 @@ -{ - "files.associations": { - "*.json.liquid": "json", - "*.yaml.liquid": "yaml", - "*.md.liquid": "markdown", - "*.js.liquid": "liquid-javascript", - "*.css.liquid": "liquid-css", - "*.scss.liquid": "liquid-scss", - "stdlib.h": "c", - "__locale": "c", - "ios": "c", - "unistd.h": "c" - } -} \ No newline at end of file diff --git a/ARCHITECTURE.md b/ARCHITECTURE.md new file mode 100644 index 0000000..ccb32ac --- /dev/null +++ b/ARCHITECTURE.md @@ -0,0 +1,359 @@ +# zeroperl Architecture + +This document explains how zeroperl is assembled, what runs at runtime, and how the shrink pipeline changes build inputs. + +## Purpose + +zeroperl packages a Perl interpreter and a curated Perl prefix into a single WASM runtime artifact set: + +- `output/zeroperl.wasm` +- `output/zeroperl_reactor.wasm` +- `output/perl-wasi-prefix/` +- optional `output/exiftool.min.pl` + +The build is orchestrated primarily by [Dockerfile](Dockerfile) and scripts in [pipeline/](pipeline). + +## High-Level Component Map + +```mermaid +flowchart LR + subgraph Host[Host machine] + User[Developer or CI] + Runner[container build or docker build] + User --> Runner + end + + subgraph BuildImage[Build image stages] + Base[base stage\nWASI SDK plus Binaryen plus C toolchain] + Native[native-perl stage\nNative Perl plus CPAN tools plus ExifTool] + Wasi[wasi-perl stage\nWASI Perl build plus prefix assembly] + Final[final stage\nWASM link plus artifacts] + + Base --> Native --> Wasi --> Final + end + + subgraph Repo[Repository inputs] + Pipe[pipeline scripts] + Stubs[stubs C runtime and wrappers] + Tools[tools shrink and smoke helpers] + Patch[patches/patch_glob.pl and patch_mg.pl] + Gen[gen shrink artifacts] + end + + Runner --> BuildImage + Repo --> BuildImage + + Final --> Artifacts[/artifacts/] + Artifacts --> Output[output directory on host] +``` + +## Build Pipeline + +### Stage 1: base + +Configured in [Dockerfile](Dockerfile). + +Responsibilities: + +- Install build toolchain and runtime dependencies. +- Install WASI SDK and Binaryen. +- Build static WASI copies of zlib and bzip2 via [pipeline/build-wasi-libs.sh](pipeline/build-wasi-libs.sh). + +### Stage 2: native-perl + +Driven by: + +- [pipeline/build-native-perl.sh](pipeline/build-native-perl.sh) +- [pipeline/build-exiftool.sh](pipeline/build-exiftool.sh) + +Responsibilities: + +- Build native Perl and install to `/build/native/prefix`. +- Install `Module::ScanDeps` via CPAN: pinned `Module-ScanDeps-1.31` for Perl + ≤5.18 (newer releases need `List::Util` newer than shipped in those trees), + otherwise latest from CPAN. +- Optionally build and minify ExifTool (`exiftool.min.pl`). Minification uses the + Debian `perltidy` package from the base image (not a CPAN `Perl::Tidy` install). +- Generate warmup include list at `gen/warmup-inc.txt`. + +### Stage 3: wasi-perl + +Driven by: + +- [tools/regen-wasm-shrink.sh](tools/regen-wasm-shrink.sh) +- [pipeline/build-wasi-perl.sh](pipeline/build-wasi-perl.sh) +- [pipeline/prepare-prefix.sh](pipeline/prepare-prefix.sh) + +Responsibilities: + +- Detect Perl version (`PERL_MAJOR`/`PERL_MINOR`) and set `OLD_PERL=1` for Perl + ≤5.18 (see `pipeline/build-wasi-perl.sh`; Perl 5.20.x is rejected outright). +- Regenerate shrink artifacts in `gen/` based on `ZEROPERL_SHRINK`. +- Apply source patches: + - `patch_glob.pl` unconditionally — removes WASI-incompatible `getpwnam`/`getpwuid` + from `bsd_glob.c`. + - `patch_mg.pl` when `OLD_PERL=1` (Perl ≤5.18) — fixes missing vtable entries in + `regen/mg_vtable.pl`. + - `patch_sv_locale.pl` for 5.28.x only — wraps unconditional `lc_numeric_set` + usage in `#ifdef USE_LOCALE_NUMERIC`. +- Append version-specific hint overrides when `OLD_PERL=1` (`d_setlocale`, `i_systime`, + `static_ext`, `noextensions`, `-Wno-return-mismatch`, etc.). +- Run `Configure`, then apply post-configure source fixes when `OLD_PERL=1`: proto.h + include guards, missing `PERL_ARGS_ASSERT` macros, `iperlsys.h` type casts. +- **`OLD_PERL` build flow (Perl ≤5.18):** pre-generate uudmap headers, build WASI `miniperl`, + substitute native `miniperl`, stub `Errno.pm`, build with `make -k`, install with + manual `cp -r lib` fallback if `make install` cannot run the WASM binary. +- **Default flow (Perl ≥5.22):** symlink `generate_uudmap`, `make utilities`, + `make`, `make install`. +- Assemble `/zeroperl` prefix, prune files, optional unicore stripping, optional + perltidy pass. +- Run in-build smoke gate after prefix assembly: when `BUILD_EXIFTOOL=true`, the last + `RUN` in the `wasi-perl` stage executes [tools/wasm-smoke.sh](tools/wasm-smoke.sh) + and fails the build if any missing module paths are detected. +- Emit embedded prefix header for final compile (`gen/zeroperl.h`, later compiled + into data C source used by link stage). + +### Stage 4: final + +Driven by [pipeline/build-wasm.sh](pipeline/build-wasm.sh). + +Responsibilities: + +- Compile stubs runtime and wrapper C code. +- Compile `stubs/zeroperl.c` (with `#ifndef av_top_index` and `#ifdef PERL_SYS_FPU_INIT` + guards for compatibility with older `libperl.a` builds such as 5.16.x). +- Link reactor module with `libperl.a`, extension archives, and emulation libs. + `-DNO_MATHOMS` is only passed for Perl 5.20+. +- Run final wasm-opt pass and write `zeroperl.wasm`. + +## Build Sequence Diagram + +```mermaid +sequenceDiagram + participant U as User or CI + participant B as Dockerfile stages + participant N as native-perl scripts + participant R as regen-wasm-shrink + participant W as wasi-perl scripts + participant L as build-wasm + + U->>B: build with args including ZEROPERL_SHRINK + B->>N: build native Perl and optional ExifTool + N-->>B: native prefix plus warmup-inc.txt + B->>R: run shrink regen before WASI Perl configure + R-->>B: traced-files and xs-static-ext and optional full artifacts + B->>W: configure and build WASI Perl + W-->>B: libperl.a plus installed WASI tree + B->>W: prepare and trim /zeroperl prefix + B->>L: compile and link wasm module + L-->>U: artifacts in /artifacts and host output +``` + +## Runtime Architecture + +Runtime logic lives mainly in [stubs/zeroperl.c](stubs/zeroperl.c). + +Major runtime responsibilities: + +- Export public C ABI entrypoints (for init, eval, run file, lifecycle, value conversion, and result APIs). +- Initialize and own a single Perl interpreter instance. +- Prepend embedded `/zeroperl/lib/` and `/zeroperl/lib//wasm32-wasi` paths to `PERL5LIB` when they are missing, while preserving host-provided search paths. +- Provide wrapped file access so Perl can read from the embedded virtual file system prefix. +- Bridge host calls and internal error reporting. + +### Runtime Data and Control Flow + +```mermaid +flowchart LR + Host[Host embedding app] --> API[Exported zeroperl_* API in stubs/zeroperl.c] + API --> Perl[Perl interpreter instance] + Perl --> FSWrap[Wrapped fopen open read stat calls] + + FSWrap --> SFS[Embedded prefix data via generated header] + FSWrap --> WasiFS[WASI preopened or host filesystem when applicable] + + Perl --> XS[xs_init registrations] + XS --> CoreExt[Built-in or linked static extensions] +``` + +## Shrink Modes and Artifact Flow + +`ZEROPERL_SHRINK` supports two modes: + +- `off`: bypass shrink regen work and keep legacy full behavior. +- `full`: enable traced site-perl copying, generated static extension hints, + linker archive list, and generated `xs_init.inc`. + +Shrink entrypoint: [tools/regen-wasm-shrink.sh](tools/regen-wasm-shrink.sh). + +The tracer ([tools/trace-zeroperl-deps.pl](tools/trace-zeroperl-deps.pl)) runs in two phases: + +1. **Trace phase**: hooks `@INC` while executing the entry script and seed `--use` modules to collect accessed files. +2. **Package-tree expansion phase** (`expand_package_trees`): after the trace, walks the full package directory subtrees on disk for explicit seed packages (`--explicit-package` / `TRACE_EXPLICIT_PACKAGES`) and optionally all traced dependency packages (`--expand-dependency-package-trees` / `TRACE_EXPAND_DEPENDENCY_PACKAGE_TREES`), registering every `.pm`, `.pl`, and `.al` file. This ensures lazy-loaded format handlers — for example `Image::ExifTool::XMP`, `Image::ExifTool::PNG`, `Image::ExifTool::TIFF` — are retained in the prefix even when not exercised during the warm-up trace. + +Key generated artifacts: + +- `gen/traced-files.txt` +- `gen/xs-static-ext.txt` +- `gen/hints-static-ext.fragment` +- `gen/wasm-auto-libs.txt` +- `gen/xs_init.inc` +- `gen/warmup-inc.txt` +- `gen/wasm-missing-paths.txt` + +### Shrink Dataflow + +```mermaid +flowchart TD + Mode[ZEROPERL_SHRINK] + Mode -->|off| Off[Skip tracer and emit steps] + Mode -->|full| Trace[tools/trace-zeroperl-deps.pl] + + Warm[gen/warmup-inc.txt] --> Trace + Allow[gen/extra-paths-allowlist.txt] --> Trace + Entry[exiftool.min.pl plus use seeds] --> Trace + + Trace --> Expand[expand_package_trees pass] + Expand --> Traced[gen/traced-files.txt] + Expand --> XSList[gen/xs-static-ext.txt] + + XSList -->|full| Emit[tools/emit-wasm-xs-bundle.pl] + Emit --> Hints[gen/hints-static-ext.fragment] + Emit --> Libs[gen/wasm-auto-libs.txt] + Emit --> XSInit[gen/xs_init.inc] + + Traced --> Prefix[pipeline/prepare-prefix.sh] + Hints --> WasiHints[pipeline/build-wasi-perl.sh] + Libs --> Link[pipeline/build-wasm.sh] + XSInit --> Link + + Prefix --> Embedded[gen/zeroperl.h and gen/zeroperl_data.c] + Embedded --> Link +``` + +## Verification and CI Architecture + +Primary CI workflow: [.github/workflows/zeroperl.yml](.github/workflows/zeroperl.yml). + +Verification layers: + +- Build full image and wasi-perl stage. +- **In-build smoke gate** (`wasi-perl` stage, after `prepare-prefix.sh`): when `BUILD_EXIFTOOL=true`, + [tools/wasm-smoke.sh](tools/wasm-smoke.sh) runs inside the container and fails the build if `gen/wasm-missing-paths.txt` is non-empty. +- **Final-stage embedded smoke** (`final` stage): when `ZEROPERL_EMBED_PREFIX=true`, + [tools/wasm-smoke.mjs](tools/wasm-smoke.mjs) runs against `/build/wasm/zeroperl.wasm` inside the image (optional `exiftool.min.pl` argument when `BUILD_EXIFTOOL=true`). +- **Embedded runtime verifier** (CI / local): `node tools/verify-embedded-inc.mjs output/zeroperl.wasm` (after `npm --prefix tools ci`) uses the local `./zeroperl-ts` submodule to instantiate the built wasm directly, verifies the embedded `/zeroperl` paths are present in `@INC`, and loads ExifTool modules without mounting `output/perl-wasi-prefix`. +- Extract and compare tracked `gen/` artifacts from container output. +- Determinism check by rebuilding wasi-perl and comparing hash manifests. Run locally with [tools/check-wasm-shrink-determinism.sh](tools/check-wasm-shrink-determinism.sh) (requires a container environment with native prefix present). +- Run prefix smoke matrix via [tools/wasm-smoke.sh](tools/wasm-smoke.sh). +- Release builds via [.github/workflows/release.yml](.github/workflows/release.yml) for + parallel multi-variant WASM artifact generation. + +```mermaid +flowchart LR + Build[Build images] --> Smoke[Smoke run] + Build --> Extract[Extract gen artifacts] + Extract --> Diff[Diff against tracked files] + Build --> Rebuild[Determinism rebuild] + Rebuild --> Hash[Compare manifests] + Smoke --> Missing[gen/wasm-missing-paths.txt must stay empty] + Diff --> Pass[CI pass] + Hash --> Pass + Missing --> Pass +``` + +## SFS Compression (ZEROPERL_SFS_COMPRESS) + +By default, `ZEROPERL_SFS_COMPRESS` resolves to `true` when `ZEROPERL_SHRINK=full` +and `false` otherwise (including `off`), but callers may still override it +explicitly. When `ZEROPERL_SFS_COMPRESS=true`, the embedded SFS payload uses +per-file LZ4 frame compression. + +Generator behavior: + +- [tools/sfs.js](tools/sfs.js) emits `codec=1` and `decompressed_size` per entry when compression is enabled. +- Each file is independently compressed as an LZ4 frame so random access remains entry-local. +- When compression is disabled, entries remain `codec=0` with raw byte spans. + +Runtime behavior: + +- [stubs/zeroperl.c](stubs/zeroperl.c) routes SFS-prefixed paths into the SFS runtime. +- [stubs/sfs_runtime.c](stubs/sfs_runtime.c) and [stubs/sfs_compression.c](stubs/sfs_compression.c) handle codec behavior per entry. +- `codec=0`: open uses raw embedded bytes. +- `codec=1`: runtime lazily decompresses with `LZ4F_*` APIs and opens the decompressed buffer. +- Decompressed buffers are cached in a global LRU: + - Max cache entries: 4096 unique decompressed files + - Total decompressed cache cap: 20 MB of cached data + - Refcounted by active file descriptors to avoid evicting in-use buffers + - If cache eviction is blocked by pinned entries, runtime degrades by serving a transient non-cached decompressed buffer for that open + - Max concurrent SFS file opens: 16 (tracked in-memory file table) + +Error policy: + +- Decompression failure is fatal for that open path: return `-1` with `errno=EIO`. +- No silent fallback to compressed/raw mismatched interpretation. + +Operational notes: + +- The 16-file open limit tracks simultaneous SFS file opens; typical Perl/ExifTool usage stays well under this threshold. +- When a new file needs decompression and all cache spots are taken by pinned (in-use) files, the runtime allocates a temporary decompressed buffer instead of failing, ensuring forward progress at the cost of short-lived non-cached copies. +- The 20 MB cache cap is soft: it triggers eviction when exceeded, but large single files may temporarily exceed the cap while cached; the cap reconverges as files close and are evicted. + +Build wiring: + +- [pipeline/prepare-prefix.sh](pipeline/prepare-prefix.sh): passes `--compress` to sfs.js when `ZEROPERL_SFS_COMPRESS=true`. +- [pipeline/build-wasm.sh](pipeline/build-wasm.sh): builds SFS runtime/compression modules and links `-llz4`. +- [Dockerfile](Dockerfile) and [build.sh](build.sh): propagate `ZEROPERL_SFS_COMPRESS` build arg into image builds. + +Operational rollback: + +- Set `ZEROPERL_SFS_COMPRESS=false` and rebuild to return to raw embedded SFS behavior. + +## Optional Embedded Prefix (ZEROPERL_EMBED_PREFIX) + +`ZEROPERL_EMBED_PREFIX` controls whether the Perl library filesystem is embedded +in the wasm binary via SFS. Default is `true` (embedded). When `false`, the wasm +ships without any embedded `.pm` files — consumers must provide the Perl library +files externally and configure `@INC` themselves. + +| `ZEROPERL_EMBED_PREFIX` | SFS embedding | Consumer must provide prefix | +| ----------------------- | ------------- | ---------------------------- | +| `true` (default) | Yes | No | +| `false` | No (empty) | Yes | + +Build behavior: + +- [pipeline/prepare-prefix.sh](pipeline/prepare-prefix.sh): when `false`, skips SFS embedding after prefix preparation and generates an empty SFS table (zero entries) via `sfs.js --empty`. +- [pipeline/build-wasm.sh](pipeline/build-wasm.sh): when `false`, forces `ZEROPERL_SFS_COMPRESS=false` (nothing to compress). +- The prefix directory (`perl-wasi-prefix/`) is still produced as a build artifact regardless of this setting. + +Consumer requirements when `false`: + +- Provide the Perl library files (from `perl-wasi-prefix/`) on a mounted filesystem. +- Set `PERL5LIB` to include the versioned lib and arch directories before calling the wasm. + +Smoke testing: + +- [tools/wasm-smoke.mjs](tools/wasm-smoke.mjs) runs core and core-mod smoke tests. +- When `ZEROPERL_EMBED_PREFIX=true`, it runs inside the Dockerfile build (embedded SFS provides modules). +- When `false`, it runs on the host via [build.sh](build.sh) with the prefix directory mounted into the MemoryFileSystem. +- [tests/smoke/core-smoke.pl](tests/smoke/core-smoke.pl) exercises: strict, warnings, File::Spec, Data::Dumper, Encode, Digest::MD5, List::Util, IO::File, Cwd, Fcntl, File::Glob, MIME::Base64, POSIX, and basic regex/string operations. + +## Source Directory Roles + +- [pipeline/](pipeline): build orchestration scripts. +- [stubs/](stubs): runtime wrapper C sources, assembly helpers, headers, and cross-compilation stubs (`Errno.pm`). +- [tools/](tools): shrink generation, smoke tooling, size reporting, utility scripts. +- [gen/](gen): generated and tracked shrink artifacts plus generated embedding inputs. +- [patches/](patches): source patches applied during WASI Perl build (`patch_glob.pl` for all versions, `patch_mg.pl` when `OLD_PERL`, `patch_sv_locale.pl` for 5.28.x). +- [tests/smoke/](tests/smoke): sample corpus for smoke coverage. +- [tests/sfs/](tests/sfs): native C unit tests for the SFS runtime and compression layer. + +## Extension and Change Guidelines + +When changing architecture-sensitive paths: + +- Keep `regen-wasm-shrink` before `build-wasi-perl` so generated hints are available at configure time. +- Keep `prepare-prefix` before final link so embedded prefix data reflects current shrink mode. +- Preserve `off` as safe fallback mode for debugging and bisecting. +- If adding new generated shrink artifacts, wire them into CI artifact extraction and determinism checks. diff --git a/Dockerfile b/Dockerfile index 5efc045..2822c4d 100644 --- a/Dockerfile +++ b/Dockerfile @@ -11,7 +11,8 @@ FROM debian:trixie-slim AS base ARG TARGETPLATFORM ARG WASI_SDK_VERSION=27 -ARG BINARYEN_VERSION=124 +ARG BINARYEN_VERSION=129 +ARG ZLIB_VERSION=1.3.2 ENV WASI_SDK_VERSION=${WASI_SDK_VERSION} \ WASI_SDK_PATH=/opt/wasi-sdk @@ -19,8 +20,8 @@ ENV WASI_SDK_VERSION=${WASI_SDK_VERSION} \ WORKDIR /build RUN apt-get update && apt-get install -y --no-install-recommends \ - build-essential curl xz-utils zlib1g-dev libbz2-dev ca-certificates \ - clang llvm lld nodejs patch perl python3 \ + build-essential curl xz-utils zlib1g-dev libbz2-dev liblz4-dev lz4 ca-certificates \ + clang llvm lld nodejs npm patch perl python3 perltidy \ && rm -rf /var/lib/apt/lists/* RUN ARCH=$(uname -m) && \ @@ -38,20 +39,23 @@ RUN ARCH=$(uname -m) && \ ENV PATH="/opt/binaryen/bin:${PATH}" COPY pipeline/build-wasi-libs.sh /build/repo/pipeline/ -RUN chmod +x /build/repo/pipeline/build-wasi-libs.sh && /build/repo/pipeline/build-wasi-libs.sh +RUN chmod +x /build/repo/pipeline/build-wasi-libs.sh && \ + ZLIB_VERSION="${ZLIB_VERSION}" /build/repo/pipeline/build-wasi-libs.sh -RUN mkdir -p /zeroperl && chmod 777 /zeroperl +RUN mkdir -p /zeroperl FROM base AS native-perl -ARG PERL_VERSION=5.42.0 -ARG EXIFTOOL_VERSION=13.42 +ARG PERL_VERSION=5.42.2 +ARG EXIFTOOL_VERSION=13.55 ARG BUILD_EXIFTOOL=true +ARG EXIFTOOL_WARMUP_MODE=curated ENV PERL_VERSION=${PERL_VERSION} \ EXIFTOOL_VERSION=${EXIFTOOL_VERSION} \ BUILD_EXIFTOOL=${BUILD_EXIFTOOL} \ + EXIFTOOL_WARMUP_MODE=${EXIFTOOL_WARMUP_MODE} \ NATIVE_DIR=/build/native \ REPO_DIR=/build/repo @@ -59,35 +63,61 @@ COPY pipeline/build-native-perl.sh pipeline/build-exiftool.sh /build/repo/pipeli RUN chmod +x /build/repo/pipeline/*.sh RUN /build/repo/pipeline/build-native-perl.sh -RUN [ "${BUILD_EXIFTOOL}" = "true" ] && /build/repo/pipeline/build-exiftool.sh || true +RUN if [ "${BUILD_EXIFTOOL}" = "true" ]; then /build/repo/pipeline/build-exiftool.sh; fi FROM native-perl AS wasi-perl -ARG PERL_VERSION=5.42.0 -ARG BUILD_EXIFTOOL=true ARG TRIM=true +ARG ZEROPERL_SHRINK=off +ARG ZEROPERL_SFS_COMPRESS= +ARG ZEROPERL_EMBED_PREFIX=true +ARG PERL_VERSION ENV PERL_VERSION=${PERL_VERSION} \ BUILD_EXIFTOOL=${BUILD_EXIFTOOL} \ TRIM=${TRIM} \ + ZEROPERL_SHRINK=${ZEROPERL_SHRINK} \ + ZEROPERL_SFS_COMPRESS=${ZEROPERL_SFS_COMPRESS} \ + ZEROPERL_EMBED_PREFIX=${ZEROPERL_EMBED_PREFIX} \ WASM_DIR=/build/wasm +# Copy package files first for npm cache layer +# zeroperl-ts must be present because tools/package.json references it via file:../zeroperl-ts +COPY zeroperl-ts/ /build/repo/zeroperl-ts/ +COPY tools/package.json tools/package-lock.json /build/repo/tools/ +RUN cd /build/repo/tools && npm ci + +# Copy remaining source (separate COPY per dir to preserve directory structure) COPY wasi-bin/ /build/repo/wasi-bin/ COPY pipeline/ /build/repo/pipeline/ COPY patches/ /build/repo/patches/ COPY stubs/ /build/repo/stubs/ COPY tools/ /build/repo/tools/ -RUN chmod +x /build/repo/wasi-bin/* /build/repo/pipeline/*.sh && mkdir -p /build/repo/gen +COPY tests/smoke/ /build/repo/tests/smoke/ +COPY tests/sfs/ /build/repo/tests/sfs/ +RUN chmod +x /build/repo/wasi-bin/* /build/repo/pipeline/*.sh \ + /build/repo/tools/*.sh /build/repo/tools/*.pl && \ + mkdir -p /build/repo/gen RUN mv /opt/binaryen/bin/wasm-opt /opt/binaryen/bin/wasm-opt-real && \ cp /build/repo/tools/wasm-opt /opt/binaryen/bin/wasm-opt && \ - chmod +x /opt/binaryen/bin/wasm-opt && \ - /build/repo/pipeline/build-wasi-perl.sh && \ - mv /opt/binaryen/bin/wasm-opt-real /opt/binaryen/bin/wasm-opt + chmod +x /opt/binaryen/bin/wasm-opt + +RUN /build/repo/tools/regen-wasm-shrink.sh + +RUN /build/repo/pipeline/build-wasi-perl.sh + +RUN mv /opt/binaryen/bin/wasm-opt-real /opt/binaryen/bin/wasm-opt RUN /build/repo/pipeline/prepare-prefix.sh +RUN node /build/repo/tests/sfs/test-generator.js + +RUN make -C /build/repo/tests/sfs test-sfs + +RUN if [ "$BUILD_EXIFTOOL" = "true" ]; then /build/repo/tools/wasm-smoke.sh /build/repo; fi + FROM wasi-perl AS final @@ -95,16 +125,24 @@ ARG STACK_SIZE=8388608 ARG INITIAL_MEMORY=33554432 ARG ASYNCIFY=true ARG WASM_OPT_FLAGS="" +ARG ZEROPERL_EMBED_PREFIX=true ENV STACK_SIZE=${STACK_SIZE} \ INITIAL_MEMORY=${INITIAL_MEMORY} \ ASYNCIFY=${ASYNCIFY} \ - WASM_OPT_FLAGS=${WASM_OPT_FLAGS} + WASM_OPT_FLAGS=${WASM_OPT_FLAGS} \ + ZEROPERL_EMBED_PREFIX=${ZEROPERL_EMBED_PREFIX} COPY stubs/ /build/repo/stubs/ RUN /build/repo/pipeline/build-wasm.sh +RUN if [ "${ZEROPERL_EMBED_PREFIX}" = "true" ]; then \ + exiftool_arg=""; \ + if [ "${BUILD_EXIFTOOL}" = "true" ]; then exiftool_arg="/build/repo/exiftool.min.pl"; fi; \ + node /build/repo/tools/wasm-smoke.mjs /build/wasm/zeroperl.wasm ${exiftool_arg}; \ + fi + RUN mkdir -p /artifacts && \ cp /build/wasm/config.h /build/wasm/zeroperl.wasm /build/wasm/zeroperl_reactor.wasm /artifacts/ && \ cp -r /zeroperl /artifacts/perl-wasi-prefix && \ @@ -114,4 +152,3 @@ RUN mkdir -p /artifacts && \ FROM debian:trixie-slim COPY --from=final /artifacts /artifacts -CMD ["sh", "-c", "ls -la /artifacts"] diff --git a/README.md b/README.md index edef5f8..1c46750 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,6 @@ zeroperl is an experimental build of Perl5 in a sandboxed, self-contained WebAssembly module. +Supported release lines are **5.16.3** and **5.42.x**. Perl **5.20.x** is rejected by the build +scripts due to a WASI memory-corruption issue during module loading. Read the full blog [here](https://andrews.substack.com/p/zeroperl-sandboxed-perl-with-webassembly) @@ -7,6 +9,7 @@ Read the full blog [here](https://andrews.substack.com/p/zeroperl-sandboxed-perl Requires Docker or Apple Container (macOS). **Docker:** + ```bash docker build -t zeroperl . mkdir -p output @@ -14,62 +17,168 @@ docker run --rm -v $(pwd)/output:/output zeroperl cp -r /artifacts/. /output/ ``` **Apple Container (macOS):** + ```bash container build -t zeroperl . mkdir -p output -container run --rm -v $(pwd)/output:/output zeroperl cp -r /artifacts/. /output/ +container run --rm zeroperl sh -c 'cd /artifacts && tar cf - .' | tar xf - -C output ``` Output in `./output/`: -- `zeroperl.wasm` — reactor with asyncify -- `zeroperl_reactor.wasm` — reactor without asyncify + +- `zeroperl.wasm` — wasm-opt output from `zeroperl_reactor.wasm` (asyncify-instrumented when `ASYNCIFY=true`; see `pipeline/build-wasm.sh`) +- `zeroperl_reactor.wasm` — linker output (`-mexec-model=reactor`) before the wasm-opt asyncify pass +- `config.h` — Perl/WASI `config.h` from the wasm build tree (useful for debugging toolchain mismatches) - `perl-wasi-prefix/` — Perl library prefix - `exiftool.min.pl` — minified ExifTool (if enabled) ### Build args **Docker:** + ```bash -docker build --build-arg PERL_VERSION=5.42.0 --build-arg BUILD_EXIFTOOL=false -t zeroperl . +docker build --build-arg PERL_VERSION=5.16.3 --build-arg BUILD_EXIFTOOL=false -t zeroperl . ``` **Apple Container:** + ```bash -container build --build-arg PERL_VERSION=5.42.0 --build-arg BUILD_EXIFTOOL=false -t zeroperl . +container build --build-arg PERL_VERSION=5.16.3 --build-arg BUILD_EXIFTOOL=false -t zeroperl . ```
-Available build arguments - -| Arg | Default | | -|-----|---------|--| -| `PERL_VERSION` | `5.42.0` | Perl source version | -| `EXIFTOOL_VERSION` | `13.42` | ExifTool version | -| `BUILD_EXIFTOOL` | `true` | Include ExifTool | -| `STACK_SIZE` | `8388608` | WASM stack (bytes) | -| `INITIAL_MEMORY` | `33554432` | WASM initial memory (bytes) | -| `ASYNCIFY` | `true` | Enable asyncify | -| `TRIM` | `true` | Strip unused modules | +Build configuration reference + +### Dockerfile build arguments + +Declared in [Dockerfile](Dockerfile) as `ARG` (pass with `--build-arg`). + +| Arg | Default | Notes | +| --------------------------------------- | ------------------------------------------------------- | ---------------------------------------------------------------------------------------------------- | +| `PERL_VERSION` | `5.42.2` | Perl source tarball version (`5.16.3` or `5.42.x`; `5.20.x` is rejected). | +| `EXIFTOOL_VERSION` | `13.55` | ExifTool release tag | +| `BUILD_EXIFTOOL` | `true` | Build and ship ExifTool | +| `EXIFTOOL_WARMUP_MODE` | `curated` | `curated` or `full` | +| `STACK_SIZE` | `8388608` | WASM stack (bytes), `final` stage | +| `INITIAL_MEMORY` | `33554432` | WASM initial memory (bytes), `final` stage | +| `ASYNCIFY` | `true` | wasm-opt asyncify imports (`final` stage) | +| `WASM_OPT_FLAGS` | `""` | Extra flags appended to the wasm-opt invocation (`final` stage) | +| `TRIM` | `true` | Strip unused modules | +| `ZEROPERL_SHRINK` | `off` | `off` or `full` | +| `ZEROPERL_SFS_COMPRESS` | auto (`true` when `ZEROPERL_SHRINK=full`, else `false`) | LZ4-framed SFS entries (`pipeline/prepare-prefix.sh` / `pipeline/build-wasm.sh`) | +| `ZEROPERL_EMBED_PREFIX` | `true` | Embed prefix in wasm via SFS (`false` = empty SFS; consumer supplies `perl-wasi-prefix/`) | + +### Shrink tracer environment + +Read by [tools/regen-wasm-shrink.sh](tools/regen-wasm-shrink.sh) during the `wasi-perl` image layer (defaults and overrides in [tools/wasm-shrink.env](tools/wasm-shrink.env)). The stock Dockerfile does **not** declare these as `ARG`, so `docker build --build-arg TRACE_…` has no effect unless you add matching `ARG`/`ENV` wiring. + +| Variable | Default | Role | +| --------------------------------------- | ------------------------------------------------------- | ---------------------------------------------------------------------------------------------------- | +| `TRACE_EXPLICIT_PACKAGES` | (empty) | Comma-separated modules for `--explicit-package` (full subtrees when expansion is on). | +| `TRACE_USE_MODULE` | `Image::ExifTool` when `BUILD_EXIFTOOL=true`, else empty | Comma-separated `--use` seeds for the tracer. | +| `TRACE_EXPAND_EXPLICIT_PACKAGE_TREES` | `true` | Expand explicit packages to full subtrees on disk. | +| `TRACE_EXPAND_DEPENDENCY_PACKAGE_TREES` | `true` | Expand traced dependency packages to full subtrees. |
+Shrink implementation notes: + +- `ZEROPERL_SHRINK=off` preserves the current full-copy / full-XS behavior. +- `ZEROPERL_SHRINK=full` enables traced site-perl copying, deterministic shrink artifacts, + generated `static_ext`, linker archives, `xs_init.inc`, and unicore stripping. +- `ZEROPERL_SFS_COMPRESS` defaults to `true` only when `ZEROPERL_SHRINK=full` (otherwise `false`); leave unset for that auto behavior or override explicitly. +- `ZEROPERL_SFS_COMPRESS=true` stores each embedded SFS file as an LZ4 frame and enables lazy decompression in the runtime. +- Compressed entries are decompressed on first open and cached in an LRU (20 MB cap, 4096 entries). +- If all cache entries are pinned and cannot be evicted, runtime serves a transient non-cached decompressed buffer for that open. +- Decompression failures return `EIO` and fail fast (no fallback to raw bytes). +- Rollback switch: set `ZEROPERL_SFS_COMPRESS=false` and rebuild. +- `ZEROPERL_EMBED_PREFIX=false` skips embedding the Perl library prefix in the wasm binary. The prefix directory is still produced as a build artifact (`perl-wasi-prefix/`), but the wasm has an empty SFS table. Consumers must provide the library files externally and set `PERL5LIB`. +- When `ZEROPERL_EMBED_PREFIX=false`, `ZEROPERL_SFS_COMPRESS` is silently forced to `false` (nothing to compress). +- `TRACE_USE_MODULE` adds `--use` seeds so the tracer executes those modules during warm-up (comma-separated). +- `TRACE_EXPLICIT_PACKAGES` registers `--explicit-package` modules; when `TRACE_EXPAND_EXPLICIT_PACKAGE_TREES=true`, those packages are retained as full directory subtrees. +- When `TRACE_EXPAND_DEPENDENCY_PACKAGE_TREES=true`, traced dependency modules are also retained as full package trees. +- Generated shrink artifacts live in `gen/` and can be refreshed via `tools/regen-wasm-shrink.sh`. +- Checked-in smoke corpus sources live in `tests/smoke/` (`sample.jpg.b64`, `sample.tiff.b64`, `sample.xmp`). +- Prefix/full image builds with `BUILD_EXIFTOOL=true` now run shrink smoke automatically in the `wasi-perl` stage and fail if missing paths are detected. +- Run smoke validation manually inside the wasi build image for version-matched Perl (Apple Containers on macOS): + - `container run --rm -v $PWD:/work -w /work zeroperl:wasi sh -lc './tools/wasm-smoke.sh .'` + It exercises `exiftool.min.pl` against that corpus and writes diagnostics to `gen/wasm-smoke.log` and missing-path findings to `gen/wasm-missing-paths.txt`. +- If `gen/wasm-missing-paths.txt` is non-empty, triage each entry into `gen/extra-paths-allowlist.txt` or trace seed/warmup inputs, then regenerate. +- For deterministic checks, run `tools/check-wasm-shrink-determinism.sh` inside the build image after native prefix/exiftool assets are present. + +### End-to-end build with build.sh + +`build.sh` drives the full pipeline: container build → artifact extract. + +```bash +# Default (Perl 5.42.2, no shrink) +./build.sh run + +# Older Perl with full shrink and compression +PERL_VERSION=5.16.3 ZEROPERL_SFS_COMPRESS=true ./build.sh run full + +# Override versions +PERL_VERSION=5.42.2 ZLIB_VERSION=1.3.2 EXIFTOOL_VERSION=13.55 ./build.sh run full +``` + ### Iterating on stubs/zeroperl.c Build from `final` stage to reuse cached wasi-perl: **Docker:** + ```bash docker build --target final -t zeroperl . ``` **Apple Container:** + ```bash container build --target final -t zeroperl . ``` +## Node tooling & submodule setup + +This repo vendors `zeroperl-ts` as a git submodule at `./zeroperl-ts`. You must +initialize submodules before running any in-repo `npm install` or `npm ci` that +resolves `@6over3/zeroperl-ts` via `file:./zeroperl-ts` (root) or +`file:../zeroperl-ts` (`tools/`). + +Clone with submodules: + +```bash +git clone --recurse-submodules https://github.com/lbe/zeroperl.git +``` + +Or, if you already cloned without submodules: + +```bash +git submodule update --init --recursive +``` + +Without `./zeroperl-ts` present, npm installs will fail because the local +`file:` dependency cannot be resolved. + +> **Windows note:** `npm file:` dependencies create symlinks under +> `node_modules`. On Windows, symlink creation may require Developer Mode or an +> elevated terminal. See [Microsoft: Enable your device for development](https://learn.microsoft.com/en-us/windows/apps/get-started/enable-your-device-for-development). + ## Testing -The easiest way to test a new build of `zeroperl.wasm` is to clone the TypeScript wrapper and run its test suite: +This repo vendors `zeroperl-ts` as `./zeroperl-ts`. After initializing +submodules (see [Node tooling & submodule setup](#node-tooling--submodule-setup)), +you can test a new `zeroperl.wasm` build using the local submodule: + +```bash +cd zeroperl-ts +npm test +``` + +You can also iterate on `zeroperl-ts` source directly inside `./zeroperl-ts`; +the parent repo tracks it as a submodule. + +If you need to work on `zeroperl-ts` upstream in isolation (e.g. to open a PR +against `https://github.com/6over3/zeroperl-ts`), clone it separately: ```bash git clone https://github.com/6over3/zeroperl-ts @@ -77,6 +186,19 @@ git clone https://github.com/6over3/zeroperl-ts See the [zeroperl-ts README](https://github.com/6over3/zeroperl-ts) for details. +For an in-repo verification that the built wasm can load modules from the +embedded `/zeroperl` prefix without mounting `output/perl-wasi-prefix`, run: + +```bash +npm --prefix tools ci +node tools/verify-embedded-inc.mjs output/zeroperl.wasm +``` + +This verifier uses the local `@6over3/zeroperl-ts` submodule (`./zeroperl-ts`) to instantiate the local wasm artifact +directly, inspects `@INC`, and requires `Image::ExifTool` modules without +providing the extracted prefix tree. It assumes the build was produced with +`BUILD_EXIFTOOL=true`. + ## Usage > **Note:** The first argument passed to Perl **must** be `zeroperl`. diff --git a/build.sh b/build.sh new file mode 100755 index 0000000..dfd1452 --- /dev/null +++ b/build.sh @@ -0,0 +1,122 @@ +#!/usr/bin/env bash +# End-to-end build: container build → artifacts. + +set -euo pipefail + +# Detect platform: Apple Containers on macOS, Docker elsewhere +if command -v container >/dev/null 2>&1; then + CONTAINER_CMD="container" +elif command -v docker >/dev/null 2>&1; then + CONTAINER_CMD="docker" +else + echo "Error: neither 'container' (Apple Containers) nor 'docker' found" >&2 + exit 1 +fi + +show_help() { + cat <<'EOF' +Usage: ./build.sh run [shrink-mode] + +End-to-end build: container build → artifact extract. + +Arguments: + run Required to execute the build (prevents accidental runs) + shrink-mode Optional: off or full (default: off) + +Environment variables: + PERL_VERSION Perl version to build (default: 5.42.2) + EXIFTOOL_VERSION ExifTool version (default: 13.55) + ZLIB_VERSION zlib version (default: 1.3.2) + ZEROPERL_NO_CACHE Pass --no-cache to container build (default: false) + ZEROPERL_EMBED_PREFIX Embed @INC prefix in wasm (default: true) + CONTAINER_BUILD_MEMORY Memory limit for container builder (default: 5G) + +Examples: + ./build.sh run # Build with defaults + ./build.sh run full # Build with full shrink mode + BUILD_EXIFTOOL=false ./build.sh run off # Perl-only build +EOF +} + +if [ "$#" -eq 0 ] || [ "$1" = "-h" ] || [ "$1" = "--help" ]; then + show_help + exit 0 +fi + +if [ "$1" != "run" ]; then + echo "Error: first argument must be 'run'. Use -h for help." >&2 + exit 1 +fi + +shift + +if [ "$#" -gt 1 ]; then + echo "usage: $0 run [shrink-mode]" >&2 + exit 1 +fi + +ZEROPERL_SHRINK="${1:-off}" +ZEROPERL_SFS_COMPRESS="${ZEROPERL_SFS_COMPRESS:-}" +PERL_VERSION="${PERL_VERSION:-5.42.2}" +ZLIB_VERSION="${ZLIB_VERSION:-1.3.2}" +EXIFTOOL_VERSION="${EXIFTOOL_VERSION:-13.55}" +ZEROPERL_NO_CACHE="${ZEROPERL_NO_CACHE:-false}" +ZEROPERL_EMBED_PREFIX="${ZEROPERL_EMBED_PREFIX:-true}" +echo ZEROPERL_NO_CACHE = $ZEROPERL_NO_CACHE +echo ZEROPERL_EMBED_PREFIX = $ZEROPERL_EMBED_PREFIX + +if [ -z "${ZEROPERL_SFS_COMPRESS}" ]; then + if [ "${ZEROPERL_SHRINK}" = "full" ]; then + ZEROPERL_SFS_COMPRESS="true" + else + ZEROPERL_SFS_COMPRESS="false" + fi +fi + +# wasm-opt flags: GUFA only for full shrink; other optimizations always present. +WASM_OPT_FLAGS='--generate-global-effects --low-memory-unused -Oz --enable-bulk-memory --enable-sign-ext --enable-reference-types --enable-multivalue --disable-extended-const --strip-producers' +if [ "${ZEROPERL_SHRINK}" = "full" ]; then + WASM_OPT_FLAGS="--gufa ${WASM_OPT_FLAGS}" +fi + +# Optional: container builder RAM. See README / container build --help. +CONTAINER_BUILD_MEMORY="${CONTAINER_BUILD_MEMORY:-5G}" +BUILD_MEM=() +if [ -n "${CONTAINER_BUILD_MEMORY}" ]; then + BUILD_MEM=(--memory "${CONTAINER_BUILD_MEMORY}") +fi + +CONTAINER_BUILD_PARAMETERS="" +if [ $ZEROPERL_NO_CACHE == "true" ]; then + CONTAINER_BUILD_PARAMETERS="--no-cache" +fi +echo CONTAINER_BUILD_PARAMETERS = $CONTAINER_BUILD_PARAMETERS + +${CONTAINER_CMD} build \ + ${BUILD_MEM[@]+"${BUILD_MEM[@]}"} \ + --build-arg "PERL_VERSION=${PERL_VERSION}" \ + --build-arg "BUILD_EXIFTOOL=${BUILD_EXIFTOOL:-true}" \ + --build-arg "EXIFTOOL_VERSION=${EXIFTOOL_VERSION}" \ + --build-arg "ZLIB_VERSION=${ZLIB_VERSION}" \ + --build-arg "WASM_OPT_FLAGS=${WASM_OPT_FLAGS}" \ + --build-arg "ZEROPERL_SHRINK=${ZEROPERL_SHRINK}" \ + --build-arg "ZEROPERL_SFS_COMPRESS=${ZEROPERL_SFS_COMPRESS}" \ + --build-arg "ZEROPERL_EMBED_PREFIX=${ZEROPERL_EMBED_PREFIX}" \ + $CONTAINER_BUILD_PARAMETERS \ + -t zeroperl \ + . + +rm -rf output > /dev/null +mkdir -p output + +mkdir -p "${PWD}/output" +${CONTAINER_CMD} run --rm zeroperl:latest sh -c 'cd /artifacts && tar cf - .' | tar xf - -C "${PWD}/output" + +# Core smoke test: wasm-smoke.mjs runs core + core-mod (+ ExifTool if available) +if [ "${ZEROPERL_EMBED_PREFIX}" = "true" ]; then + node tools/wasm-smoke.mjs output/zeroperl.wasm +else + node tools/wasm-smoke.mjs output/zeroperl.wasm output/perl-wasi-prefix +fi + +echo "Done" diff --git a/package.json b/package.json new file mode 100644 index 0000000..640674e --- /dev/null +++ b/package.json @@ -0,0 +1,11 @@ +{ + "devDependencies": { + "@6over3/zeroperl-ts": "file:./zeroperl-ts", + "@eslint/js": "^10.0.1", + "eslint": "^10.2.0", + "globals": "^17.4.0" + }, + "scripts": { + "verify:embedded-inc": "node tools/verify-embedded-inc.mjs" + } +} diff --git a/patches/glob.patch b/patches/glob.patch deleted file mode 100644 index b2fbec7..0000000 --- a/patches/glob.patch +++ /dev/null @@ -1,50 +0,0 @@ -diff --git a/ext/File-Glob/bsd_glob.c b/ext/File-Glob/bsd_glob.c -index 3d402e0b45..f78836d136 100644 ---- a/ext/File-Glob/bsd_glob.c -+++ b/ext/File-Glob/bsd_glob.c -@@ -70,14 +70,6 @@ static char sscsid[]= "$OpenBSD: glob.c,v 1.8.10.1 2001/04/10 jason Exp $"; - #include - - #include "bsd_glob.h" --#ifdef I_PWD --# include --#else --#if defined(HAS_PASSWD) && !defined(VMS) -- struct passwd *getpwnam(char *); -- struct passwd *getpwuid(Uid_t); --#endif --#endif - - #ifndef MAXPATHLEN - # ifdef PATH_MAX -@@ -454,13 +446,7 @@ globtilde(const Char *pattern, Char *patbuf, size_t patbuf_len, glob_t *pglob) - * or $USERPROFILE on DOSISH systems - */ - if ((h = PerlEnv_getenv("HOME")) == NULL) { --#ifdef HAS_PASSWD -- struct passwd *pwd; -- if ((pwd = getpwuid(getuid())) == NULL) -- return pattern; -- else -- h = pwd->pw_dir; --#elif DOSISH -+#ifdef DOSISH - /* - * When no passwd file, fallback to the USERPROFILE - * environment variable on DOSish systems. -@@ -476,15 +462,7 @@ globtilde(const Char *pattern, Char *patbuf, size_t patbuf_len, glob_t *pglob) - /* - * Expand a ~user - */ --#ifdef HAS_PASSWD -- struct passwd *pwd; -- if ((pwd = getpwnam((char*) patbuf)) == NULL) -- return pattern; -- else -- h = pwd->pw_dir; --#else - return pattern; --#endif - } - - /* Copy the home directory */ diff --git a/patches/patch_glob.pl b/patches/patch_glob.pl new file mode 100644 index 0000000..c12c2b6 --- /dev/null +++ b/patches/patch_glob.pl @@ -0,0 +1,120 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +# Fix for all Perl versions: bsd_glob.c references pwd.h, getpwuid(), and +# getpwnam() which are unavailable in WASI (no POSIX passwd database). +# We strip the I_PWD include block and replace the passwd lookups with +# simple fallbacks. + +open my $fh, '<', 'ext/File-Glob/bsd_glob.c' or die "Cannot open file: $!"; +my @lines = <$fh>; +close $fh; + +my @errors; +my @out; +my $i = 0; + +# Match a #if / #ifdef / #ifndef directive at the start of a line. +my $RE_IF_DIRECTIVE = qr{^ \s* \# (if|ifdef|ifndef) \b }x; + +# Match an #endif directive at the start of a line. +my $RE_ENDIF = qr{^ \s* \# endif \b }x; + +# Match the start of an #ifdef I_PWD block. +my $RE_IFDEF_I_PWD = qr{^ \s* \# ifdef \s+ I_PWD \b }x; + +# Match the start of an #ifdef HAS_PASSWD block. +my $RE_IFDEF_HAS_PWD = qr{^ \s* \# ifdef \s+ HAS_PASSWD \b }x; + +# Detect the getpwuid / DOSISH variant inside a HAS_PASSWD block. +my $RE_HAS_GETPWUID = qr{ \b getpwuid \b .* \# elif \s+ DOSISH }xs; + +# Detect the getpwnam variant inside a HAS_PASSWD block. +my $RE_HAS_GETPWNAM = qr{ \b getpwnam \b }x; + +# --------------------------------------------------------------------------- +# Given the index of a line that starts an #if block, return the index of +# the matching #endif. Handles nested #if/#ifdef/#ifndef directives. +# --------------------------------------------------------------------------- +sub skip_if_block { + my ($lines, $start_idx) = @_; + my $depth = 1; + my $j = $start_idx; + + while (++$j < @$lines && $depth > 0) { + $depth++ if $lines->[$j] =~ $RE_IF_DIRECTIVE; + $depth-- if $lines->[$j] =~ $RE_ENDIF; + } + return $j - 1; +} + +while ($i < @lines) { + my $line = $lines[$i]; + + # ----------------------------------------------------------------------- + # 1. Strip the entire #ifdef I_PWD ... #endif block (includes pwd.h). + # ----------------------------------------------------------------------- + if ($line =~ $RE_IFDEF_I_PWD) { + my $end = skip_if_block(\@lines, $i); + $i = $end + 1; + next; + } + + # ----------------------------------------------------------------------- + # 2. Replace the #ifdef HAS_PASSWD block that uses getpwuid(). + # This variant has a DOSISH #elif branch; we keep only the DOSISH + # body and add a generic #else fallback for non-DOSISH builds. + # ----------------------------------------------------------------------- + if ( $line =~ $RE_IFDEF_HAS_PWD + && join("", @lines[$i .. $i + 25]) =~ $RE_HAS_GETPWUID) + { + my $end = skip_if_block(\@lines, $i); + push @out, "#ifdef DOSISH\n"; + push @out, "\t\t\t/* DOSISH fallback */\n"; + push @out, "\t\t\tif ((h = getenv(\"USERPROFILE\")) == NULL) {\n"; + push @out, "\t\t\t return pattern;\n"; + push @out, "\t\t\t}\n"; + push @out, "#else\n"; + push @out, " return pattern;\n"; + push @out, "#endif\n"; + $i = $end + 1; + next; + } + + # ----------------------------------------------------------------------- + # 3. Replace the #ifdef HAS_PASSWD block that uses getpwnam(). + # No DOSISH branch here — just stub it out. + # ----------------------------------------------------------------------- + if ( $line =~ $RE_IFDEF_HAS_PWD + && join("", @lines[$i .. $i + 20]) =~ $RE_HAS_GETPWNAM) + { + my $end = skip_if_block(\@lines, $i); + push @out, "return pattern;\n"; + $i = $end + 1; + next; + } + + push @out, $line; + $i++; +} + +my $out_str = join("", @out); + +# --------------------------------------------------------------------------- +# Post-flight checks: make sure none of the removed symbols leaked through. +# --------------------------------------------------------------------------- +push @errors, "pwd.h include block still present" if $out_str =~ /#ifdef I_PWD/; +push @errors, "getpwuid block not replaced" if $out_str =~ /getpwuid/; +push @errors, "getpwnam block not replaced" if $out_str =~ /getpwnam/; + +if (@errors) { + die "Patch failed with " . scalar(@errors) . " error(s):\n" + . join("\n", @errors) . "\n"; +} + +open $fh, '>', 'ext/File-Glob/bsd_glob.c' or die "Cannot write file: $!"; +print $fh @out; +close $fh; + +print "Patch applied successfully.\n"; diff --git a/patches/patch_iperlsys.pl b/patches/patch_iperlsys.pl new file mode 100644 index 0000000..3cbd350 --- /dev/null +++ b/patches/patch_iperlsys.pl @@ -0,0 +1,36 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +# Fix for Perl <=5.18: iperlsys.h defines PerlProc_setuid/setgid with plain +# setuid/setgid calls, but WASI's gid_t/uid_t are 32-bit while Perl passes UV +# (64-bit). This causes wasm-ld signature mismatch. We add explicit casts. +# +# Only the single-line macro definitions are touched; multi-line variants that +# end with backslash are left untouched. + +my $file = 'iperlsys.h'; +open my $fh, '<', $file or die "Cannot read $file: $!"; +my $content = do { local $/; <$fh> }; +close $fh; + +my $replaced = 0; + +# Match exactly: +# #define PerlProc_setgid(g)setgid((g)) +# and replace setgid((g)) with setgid((Gid_t)(g)), preserving whitespace. +$replaced++ if $content =~ s/^(#\s*define\s+PerlProc_setgid\(g\))(\s+)setgid\(\(g\)\)$/${1}${2}setgid((Gid_t)(g))/m; + +# Same for setuid. +$replaced++ if $content =~ s/^(#\s*define\s+PerlProc_setuid\(u\))(\s+)setuid\(\(u\)\)$/${1}${2}setuid((Uid_t)(u))/m; + +if ($replaced != 2) { + die "iperlsys.h patch expected 2 replacements, got $replaced. " + . "The macro format may have changed.\n"; +} + +open $fh, '>', $file or die "Cannot write $file: $!"; +print $fh $content; +close $fh; + +print "iperlsys.h patch applied successfully ($replaced replacements).\n"; diff --git a/patches/patch_mg.pl b/patches/patch_mg.pl new file mode 100755 index 0000000..f0d3da6 --- /dev/null +++ b/patches/patch_mg.pl @@ -0,0 +1,77 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +# Fix for Perl ≤5.18: mg_vtable.pl is missing vtable entries for vstring, +# amagic, and amagicelem magic types. These exist in the C source but +# the regen script does not emit them, causing undefined symbol errors +# when linking XS modules that reference PL_vtbl_vstring / PL_vtbl_amagic. +# This was fixed in 5.20+ by adding the entries upstream. + +my $dir = $ENV{WASM_DIR} || '/build/wasm'; +my $f = "$dir/regen/mg_vtable.pl"; + +open my $fh, '<', $f or die "Cannot open $f: $!"; +my $c = do { local $/; <$fh> }; +close $fh; + +# --------------------------------------------------------------------------- +# 1. Add vtable => 'vstring' to the vstring magic definition. +# +# Before: vstring => { char => 'V', value_magic => 1 +# After: vstring => { char => 'V', vtable => 'vstring', value_magic => 1 +# --------------------------------------------------------------------------- +$c =~ s{ + ( # $1 - prefix to keep + vstring \s* => \s* \{ \s* + char \s* => \s* 'V' , \s* + ) + ( # $2 - suffix to keep + value_magic \s* => \s* 1 + ) +}{${1}vtable => 'vstring', $2}x; + +# --------------------------------------------------------------------------- +# 2. Insert amagic / amagicelem entries before the "overload" entry. +# +# The mg_vtable.pl file contains a placeholder comment about where the +# old overload magic used to live. We splice two new magic entries +# (amagic and amagicelem) between that comment and the real overload +# definition that follows it. +# --------------------------------------------------------------------------- +$c =~ s{ + ( # $1 - original comment line + \# \s* overload, \s* or \s* type \s* "A" \s* magic, \s* used \s* to \s* be \s* here .*? \n + ) + ( \s+ overload ) # $2 - the "overload" entry that follows +}{ +$1 amagic => { char => 'A', vtable => 'amagic', desc => 'AMG hash' }, + amagicelem => { char => 'a', vtable => 'amagicelem', desc => 'AMG element' }, +$2 +}sx; + +# --------------------------------------------------------------------------- +# 3. Add empty placeholder entries for vstring, amagic, and amagicelem +# immediately after the destruct entry. +# +# Before: 'destruct' => {free => 'freedestruct'}, +# After: 'destruct' => {free => 'freedestruct'}, +# 'vstring' => {}, +# 'amagic' => {}, +# 'amagicelem' => {}, +# --------------------------------------------------------------------------- +$c =~ s{ + ( # $1 - the destruct line to keep + 'destruct' \s* => \s* \{ free \s* => \s* 'freedestruct' \} , + ) +}{$1 + 'vstring' => {}, + 'amagic' => {}, + 'amagicelem' => {}, +}x; + +open $fh, '>', $f or die "Cannot write $f: $!"; +print $fh $c; +close $fh; + +system 'perl', $f; diff --git a/patches/patch_sv_locale.pl b/patches/patch_sv_locale.pl new file mode 100644 index 0000000..cd24ba0 --- /dev/null +++ b/patches/patch_sv_locale.pl @@ -0,0 +1,39 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +# Fix for Perl 5.28.x: lc_numeric_set is declared inside #ifdef USE_LOCALE_NUMERIC +# but used unconditionally at the end of Perl_sv_vcatpvfn_flags. +# This was fixed in 5.30+ by wrapping the usage in #ifdef USE_LOCALE_NUMERIC. + +my $f = 'sv.c'; +open my $fh, '<', $f or die "Cannot open $f: $!"; +my $c = do { local $/; <$fh> }; +close $fh; + +# --------------------------------------------------------------------------- +# Wrap the unconditional lc_numeric_set block at the end of +# Perl_sv_vcatpvfn_flags in #ifdef USE_LOCALE_NUMERIC. +# +# The block looks like: +# if (lc_numeric_set) { +# RESTORE_LC_NUMERIC(); /* Done outside loop, so don't have to +# save/restore each iteration. */ +# } +# --------------------------------------------------------------------------- +$c =~ s{ + ( # $1 - the entire block to wrap + \n + \s{4} if \s* \( lc_numeric_set \) \s* \{ \n + \s{8} RESTORE_LC_NUMERIC \(\) ; + .*? # swallow the multi-line comment + save/restore \s+ each \s+ iteration\. \s* \*/ \n + \s{4} \} + ) +}{#ifdef USE_LOCALE_NUMERIC$1\n#endif}sx; + +open $fh, '>', $f or die "Cannot write $f: $!"; +print $fh $c; +close $fh; + +print "sv.c locale patch applied successfully.\n"; diff --git a/pipeline/build-exiftool.sh b/pipeline/build-exiftool.sh index 06ff432..0da7d30 100644 --- a/pipeline/build-exiftool.sh +++ b/pipeline/build-exiftool.sh @@ -1,19 +1,46 @@ #!/bin/sh set -e -EXIFTOOL_VERSION="${EXIFTOOL_VERSION:-13.42}" +# Build ExifTool natively and install it into the native prefix. +# Also generates a "warmup" module list (the set of .pm files ExifTool +# loads at startup) which is used by the SFS builder to ensure those +# files are present in the embedded prefix. +# Finally strips signal handlers and runs perltidy to produce a +# minified exiftool.min.pl for size-sensitive builds. + +EXIFTOOL_VERSION="${EXIFTOOL_VERSION:-13.55}" NATIVE_DIR="${NATIVE_DIR:-/build/native}" REPO_DIR="${REPO_DIR:-/build/repo}" +PERL_VERSION="${PERL_VERSION:-5.42.2}" +EXIFTOOL_WARMUP_MODE="${EXIFTOOL_WARMUP_MODE:-curated}" +WARMUP_INC_OUT="${WARMUP_INC_OUT:-$REPO_DIR/gen/warmup-inc.txt}" export PATH="$NATIVE_DIR/prefix/bin:$PATH" PERL="$NATIVE_DIR/prefix/bin/perl" -curl -fsSL "https://www.exiftool.org/Image-ExifTool-${EXIFTOOL_VERSION}.tar.gz" | tar -xzf - -C /build -cd "/build/Image-ExifTool-${EXIFTOOL_VERSION}" +# Use the GitHub tags tarball because exiftool.org only reliably serves the +# latest release tarball under the old naming scheme. +curl -fsSL "https://github.com/exiftool/exiftool/archive/refs/tags/${EXIFTOOL_VERSION}.tar.gz" | tar -xzf - -C /build +cd "/build/exiftool-${EXIFTOOL_VERSION}" $PERL Makefile.PL make + +if [ "$EXIFTOOL_WARMUP_MODE" = "full" ]; then + make test +fi + make install PREFIX="$NATIVE_DIR/prefix" +mkdir -p "$(dirname "$WARMUP_INC_OUT")" + +"$PERL" -I"$NATIVE_DIR/prefix/lib/perl5/site_perl/$PERL_VERSION" -MImage::ExifTool -e ' + Image::ExifTool->new; + print "$INC{$_}\n" for sort keys %INC; +' \ + | awk 'NF > 0' \ + | sed 's|\\|/|g' \ + | sort -u > "$WARMUP_INC_OUT" + cd "$REPO_DIR" sed -i "/\$SIG{INT}\\s*=\\s*'SigInt';/d" "$NATIVE_DIR/prefix/bin/exiftool" sed -i "/\$SIG{CONT}\\s*=\\s*'SigCont';/d" "$NATIVE_DIR/prefix/bin/exiftool" diff --git a/pipeline/build-native-perl.sh b/pipeline/build-native-perl.sh index 545b7ae..69d0327 100644 --- a/pipeline/build-native-perl.sh +++ b/pipeline/build-native-perl.sh @@ -1,7 +1,12 @@ #!/bin/sh set -e -PERL_VERSION="${PERL_VERSION:-5.42.0}" +# Build a native (host-architecture) Perl in /build/native. +# This native perl is used during cross-compilation as hostperl/miniperl +# and to run generate_uudmap. It also provides a CPAN client for +# installing Module::ScanDeps and any other build-time dependencies. + +PERL_VERSION="${PERL_VERSION:-5.42.2}" URLPERL="https://www.cpan.org/src/5.0/perl-${PERL_VERSION}.tar.gz" NATIVE_DIR="${NATIVE_DIR:-/build/native}" NPROC="${NPROC:-$(nproc)}" @@ -9,20 +14,89 @@ NPROC="${NPROC:-$(nproc)}" mkdir -p "$NATIVE_DIR" curl -fsSL "$URLPERL" | tar -xzf - --strip-components=1 --directory="$NATIVE_DIR" +# perl build variables +PERL_MAJOR=$(echo "$PERL_VERSION" | cut -d. -f1) +PERL_MINOR=$(echo "$PERL_VERSION" | cut -d. -f2) + +if [ "$PERL_MAJOR" -lt 5 ] || { [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -lt 16 ]; }; then + echo "error: Perl $PERL_VERSION is not supported. Minimum supported version is 5.16.3." >&2 + exit 1 +fi + +PERL_OPTIMIZE="-Oz" +PERL_LIBS="-lm -lcrypt" + cd "$NATIVE_DIR" + + +# Build the static extension list based on Perl version. +# Some extensions don't exist or are pure-Perl (no XS) in older Perl. +# The native build needs a working perl with enough extensions to run +# perltidy and Module::ScanDeps — it doesn't need every extension. + +# POSIX is needed by version.pm's pure-Perl fallback (vpp.pm) +# Minimum supported version is 5.16.3; all extensions below are available. +# 5.22+ removed Unicode::Normalize XS (it's pure-Perl now) +# +# NOTE: 're' is excluded for 5.38.x. It copies regcomp.c/regcomp_invlist.c +# into its own build, duplicating symbols from libperl.a when statically linked. +# Other versions build 're' as a shared library (no conflict). +if [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -eq 38 ]; then + NATIVE_STATIC_EXT="mro File/Glob Sys/Hostname PerlIO/via PerlIO/encoding attributes Digest/MD5 Digest/SHA Math/BigInt/FastCalc Data/Dumper I18N/Langinfo Time/HiRes IO Hash/Util Filter/Util/Call Encode Compress/Raw/Zlib Compress/Raw/Bzip2 MIME/Base64 Cwd List/Util Fcntl Opcode POSIX Devel/Peek Sys/Syslog B IPC/SysV Socket Storable Hash/Util/FieldHash Time/Piece Unicode/Collate Encode/Unicode Encode/JP Encode/KR Encode/EBCDIC Encode/CN Encode/Symbol Encode/Byte Encode/TW PerlIO/mmap" +else + NATIVE_STATIC_EXT="re mro File/Glob Sys/Hostname PerlIO/via PerlIO/encoding attributes Digest/MD5 Digest/SHA Math/BigInt/FastCalc Data/Dumper I18N/Langinfo Time/HiRes IO Hash/Util Filter/Util/Call Encode Compress/Raw/Zlib Compress/Raw/Bzip2 MIME/Base64 Cwd List/Util Fcntl Opcode POSIX Devel/Peek Sys/Syslog B IPC/SysV Socket Storable Hash/Util/FieldHash Time/Piece Unicode/Collate Encode/Unicode Encode/JP Encode/KR Encode/EBCDIC Encode/CN Encode/Symbol Encode/Byte Encode/TW PerlIO/mmap" +fi +if [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -le 18 ]; then + NATIVE_STATIC_EXT="Unicode/Normalize $NATIVE_STATIC_EXT" +fi + sh +x ./Configure \ -sde \ - -Dman1dir=none \ - -Dman3dir=none \ -Dprefix="$NATIVE_DIR/prefix" \ -Dusedevel \ -Uversiononly \ - -Dlibs="-lpthread -ldl -lm -lc -lz" \ - -Dstatic_ext="mro Devel/Peek File/DosGlob File/Glob Sys/Syslog Sys/Hostname PerlIO/via PerlIO/mmap PerlIO/encoding B attributes Unicode/Normalize Unicode/Collate threads threads/shared IPC/SysV re Digest/MD5 Digest/SHA SDBM_File Math/BigInt/FastCalc Data/Dumper I18N/Langinfo Time/HiRes Time/Piece IO Socket Hash/Util/FieldHash Hash/Util Filter/Util/Call POSIX Encode/Unicode Encode Encode/JP Encode/KR Encode/EBCDIC Encode/CN Encode/Symbol Encode/Byte Encode/TW Compress/Raw/Zlib Compress/Raw/Bzip2 MIME/Base64 Cwd Storable List/Util Fcntl Opcode" + -Dstatic_ext="$NATIVE_STATIC_EXT" \ + -Duselargefiles \ + -Uuse64bitint \ + -Uusethreads \ + -Uuseithreads \ + -Uusemultiplicity \ + -Uusesfio \ + -Uuseshrplib \ + -Dcc="$PERL_CC" \ + -Doptimize="$PERL_OPTIMIZE" \ + -Dlibs="$PERL_LIBS" \ + -Uusevendorprefix \ + -Uman1dir \ + -Uman3dir \ + -Usiteman1dir \ + -Usiteman3dir \ + -Duseperlio \ make -j"$NPROC" make install export PATH="$NATIVE_DIR/prefix/bin:$PATH" -echo "yes" | cpan App::cpanminus -cpanm Perl::Tidy + +export PERL_MM_USE_DEFAULT=1 + +# Install Module::ScanDeps: use older version for 5.18 and earlier (latest requires List::Util 1.33+) +if [ "$PERL_MAJOR" -lt 5 ] || { [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -le 18 ]; }; then + # Old cpan clients (e.g. v1.9800 in 5.16.3) don't support -T and fail to + # resolve AUTHOR/Dist-Version to .tar.gz, so install manually. + curl -fsSL "https://cpan.metacpan.org/authors/id/R/RS/RSCHUPP/Module-ScanDeps-1.31.tar.gz" | tar -xzf - -C /tmp + cd /tmp/Module-ScanDeps-1.31 + "$NATIVE_DIR/prefix/bin/perl" Makefile.PL + make + make install + cd - + rm -rf /tmp/Module-ScanDeps-1.31 +else + cpan -T Module::ScanDeps +fi + +# Verify installation; fail the build if the module is missing +"$NATIVE_DIR/prefix/bin/perl" -MModule::ScanDeps -e1 || { + echo "error: Module::ScanDeps is not installed" >&2 + exit 1 +} diff --git a/pipeline/build-wasi-libs.sh b/pipeline/build-wasi-libs.sh index 97f75ee..5ace101 100755 --- a/pipeline/build-wasi-libs.sh +++ b/pipeline/build-wasi-libs.sh @@ -1,7 +1,10 @@ #!/bin/sh -# Cross-compile zlib and bzip2 for WASI, install into the WASI sysroot. set -e +# Cross-compile zlib, bzip2, and lz4 for wasm32-wasi and install them into +# the WASI sysroot so that Perl's Compress::Raw::Zlib, Compress::Raw::Bzip2, +# and the SFS compression layer can link against them. + WASI_SDK_PATH="${WASI_SDK_PATH:-/opt/wasi-sdk}" SYSROOT="$WASI_SDK_PATH/share/wasi-sysroot" LIBDIR="$SYSROOT/lib/wasm32-wasi" @@ -11,8 +14,9 @@ AR="$WASI_SDK_PATH/bin/llvm-ar" RANLIB="$WASI_SDK_PATH/bin/llvm-ranlib" CFLAGS="--target=wasm32-wasi --sysroot=$SYSROOT -O3 -w" -ZLIB_VERSION="${ZLIB_VERSION:-1.3.1}" +ZLIB_VERSION="${ZLIB_VERSION:-1.3.2}" BZIP2_VERSION="${BZIP2_VERSION:-1.0.8}" +LZ4_VERSION="${LZ4_VERSION:-1.10.0}" WORK="/tmp/wasi-libs" mkdir -p "$WORK" @@ -20,7 +24,7 @@ mkdir -p "$WORK" # --- zlib --- echo "Building zlib $ZLIB_VERSION for WASI..." cd "$WORK" -curl -fsSL "https://zlib.net/fossils/zlib-${ZLIB_VERSION}.tar.gz" | tar -xzf - +curl -fsSL "https://github.com/madler/zlib/releases/download/v${ZLIB_VERSION}/zlib-${ZLIB_VERSION}.tar.gz" | tar -xzf - cd "zlib-${ZLIB_VERSION}" CC="$CC" CFLAGS="$CFLAGS" AR="$AR" RANLIB="$RANLIB" \ @@ -41,5 +45,18 @@ make -j"$(nproc)" libbz2.a \ cp libbz2.a "$LIBDIR/" cp bzlib.h "$INCDIR/" +# --- lz4 --- +echo "Building lz4 $LZ4_VERSION for WASI..." +cd "$WORK" +curl -fsSL "https://github.com/lz4/lz4/archive/refs/tags/v${LZ4_VERSION}.tar.gz" | tar -xzf - +cd "lz4-${LZ4_VERSION}" + +make -j"$(nproc)" -C lib liblz4.a \ + CC="$CC $CFLAGS" \ + AR="$AR" \ + RANLIB="$RANLIB" +cp lib/liblz4.a "$LIBDIR/" +cp lib/lz4.h lib/lz4frame.h lib/lz4hc.h "$INCDIR/" + rm -rf "$WORK" -echo "zlib and bzip2 installed into $SYSROOT" +echo "zlib, bzip2, and lz4 installed into $SYSROOT" diff --git a/pipeline/build-wasi-perl.sh b/pipeline/build-wasi-perl.sh index 8a37da5..dcfd2be 100644 --- a/pipeline/build-wasi-perl.sh +++ b/pipeline/build-wasi-perl.sh @@ -1,16 +1,49 @@ #!/bin/sh set -e -PERL_VERSION="${PERL_VERSION:-5.42.0}" +# Cross-compile Perl for wasm32-wasi. +# +# Pipeline position: runs after build-native-perl.sh and build-wasi-libs.sh. +# Downloads the Perl source, applies WASI-specific hints and patches, +# configures for cross-compilation, builds libperl.a and the perl binary, +# and installs into /zeroperl. +# +# Supports Perl 5.16.3 through 5.42.2 with version-specific workarounds +# for older releases (OLD_PERL path for ≤5.18). + +PERL_VERSION="${PERL_VERSION:-5.42.2}" URLPERL="https://www.cpan.org/src/5.0/perl-${PERL_VERSION}.tar.gz" WASI_SDK_PATH="${WASI_SDK_PATH:-/opt/wasi-sdk}" WASM_DIR="${WASM_DIR:-/build/wasm}" NATIVE_DIR="${NATIVE_DIR:-/build/native}" REPO_DIR="${REPO_DIR:-/build/repo}" NPROC="${NPROC:-$(nproc)}" +ZEROPERL_SHRINK="${ZEROPERL_SHRINK:-off}" export PATH="$REPO_DIR/wasi-bin:$PATH" +PERL_MAJOR=$(echo "$PERL_VERSION" | cut -d. -f1) +PERL_MINOR=$(echo "$PERL_VERSION" | cut -d. -f2) + +if [ "$PERL_MAJOR" -lt 5 ] || { [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -lt 16 ]; }; then + echo "error: Perl $PERL_VERSION is not supported. Minimum supported version is 5.16.3." >&2 + exit 1 +fi + +# Perl 5.20.x has a memory corruption bug when compiled to wasm32-wasi that +# crashes during compilation of modules like Carp and Encode. The bug +# reproduces across WASM runtimes (wazero, V8). Use 5.18.4 or 5.22.x instead. +if [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -eq 20 ]; then + echo "error: Perl 5.20.x is not supported in zeroperl due to a WASM code-generation" >&2 + echo " bug that corrupts memory during module loading." >&2 + exit 1 +fi + +OLD_PERL=0 +if [ "$PERL_MAJOR" -lt 5 ] || { [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -le 18 ]; }; then + OLD_PERL=1 +fi + mkdir -p "$WASM_DIR" curl -fsSL "$URLPERL" | tar -xzf - --strip-components=1 --directory="$WASM_DIR" @@ -23,30 +56,276 @@ sed -e "s|__STUBS_DIR__|$REPO_DIR/stubs|g" \ -e "s|__WASI_SDK_VERSION__|wasi-sdk-$WASI_VERSION|g" \ "$REPO_DIR/pipeline/hints-wasi.sh" > "$WASM_DIR/hints/wasi.sh" +# 5.38.x: PL_cur_locale_obj referenced under wrong #ifdef guard in perl.c +# and locale.c — prevent USE_POSIX_2008_LOCALE from being defined. +# Also remove 're' from static_ext: regcomp.c symbols duplicated in re.a +# for this version (get_ANYOFHbbm_contents etc.). +if [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -eq 38 ]; then + cat >> "$WASM_DIR/hints/wasi.sh" << 'HINTS_538' +d_newlocale='undef' +d_uselocale='undef' +d_duplocale='undef' +d_freelocale='undef' +d_querylocale='undef' +static_ext='mro Time/HiRes File/Glob Sys/Hostname PerlIO/via PerlIO/mmap PerlIO/encoding attributes Unicode/Collate Digest/MD5 Digest/SHA Math/BigInt/FastCalc Data/Dumper I18N/Langinfo Time/Piece IO Hash/Util/FieldHash Hash/Util Filter/Util/Call Encode/Unicode Encode Encode/JP Encode/KR Encode/EBCDIC Encode/CN Encode/Symbol Encode/Byte Encode/TW Compress/Raw/Zlib Compress/Raw/Bzip2 MIME/Base64 Cwd List/Util Fcntl Opcode' +HINTS_538 +fi + +# Append version-specific hint overrides for 5.20 and earlier +if [ "$OLD_PERL" = 1 ]; then + # Add -Wno-return-mismatch to ccflags/cppflags by appending to the + # hints file. The variables are expanded when Configure sources the + # hints, so the original flags (set earlier in the file) are preserved. + cat >> "$WASM_DIR/hints/wasi.sh" << 'HINTS_OLD_FLAGS' +ccflags="$ccflags -Wno-return-mismatch" +cppflags="$cppflags -Wno-return-mismatch" +HINTS_OLD_FLAGS + + # Extension list: all OLD_PERL versions use the same set + # (POSIX, Socket, etc. need sys/wait.h and other WASI-missing headers) + WASI_STATIC_EXT="mro Time/HiRes File/Glob Sys/Hostname PerlIO/via PerlIO/encoding attributes Unicode/Normalize re Digest/MD5 Digest/SHA Math/BigInt/FastCalc Data/Dumper I18N/Langinfo IO Hash/Util Filter/Util/Call Encode Compress/Raw/Zlib Compress/Raw/Bzip2 MIME/Base64 Cwd List/Util Fcntl Opcode Unicode/Collate Time/Piece Hash/Util/FieldHash PerlIO/mmap" + WASI_NOEXT="POSIX Socket Devel/Peek Sys/Syslog B Storable threads threads/shared IPC/SysV SDBM_File File/DosGlob Errno" + + cat >> "$WASM_DIR/hints/wasi.sh" << HINTS +# 5.18 and earlier overrides (built for $PERL_VERSION) +d_setlocale='define' +i_systime='undef' +i_systimek='undef' +i_systimes='define' +d_setgid='undef' +d_setuid='undef' +d_setegid='undef' +d_seteuid='undef' +d_setregid='undef' +d_setresgid='undef' +d_setresuid='undef' +d_setreuid='undef' +noextensions='$WASI_NOEXT' +static_ext='$WASI_STATIC_EXT' +HINTS +fi + +# Perl 5.28.x has locale-related compile bugs when USE_LOCALE is undefined +# (lc_numeric_set used outside #ifdef, _CHECK_AND_WARN_PROBLEMATIC_LOCALE +# missing in #else branch). Defining d_setlocale enables USE_LOCALE and +# bypasses these issues, matching the behavior of 5.26 and earlier. +if [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -eq 28 ]; then + cat >> "$WASM_DIR/hints/wasi.sh" << 'HINTS' +d_setlocale='define' +HINTS +fi + +if [ "$ZEROPERL_SHRINK" = "full" ] && [ -f "$REPO_DIR/gen/hints-static-ext.fragment" ]; then + cat "$REPO_DIR/gen/hints-static-ext.fragment" >> "$WASM_DIR/hints/wasi.sh" +fi + cd "$WASM_DIR" # Apply patches chmod u+w ./ext/File-Glob/bsd_glob.c -patch -p1 < "$REPO_DIR/patches/glob.patch" +perl "$REPO_DIR/patches/patch_glob.pl" chmod u-w ./ext/File-Glob/bsd_glob.c +# patch earlier versions of perl +if [ "$OLD_PERL" = 1 ]; then + # mg_vtable.pl was introduced in 5.16; patch only exists there + if [ -f "$WASM_DIR/regen/mg_vtable.pl" ]; then + perl "$REPO_DIR/patches/patch_mg.pl" + fi +fi + +# patch 5.28.x locale bug: lc_numeric_set used outside #ifdef USE_LOCALE_NUMERIC +if [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -eq 28 ]; then + perl "$REPO_DIR/patches/patch_sv_locale.pl" +fi + # Configure wasiconfigure sh ./Configure -sde -Dhintfile=wasi # Fix locale settings that Configure overrides -sed -i "s/d_perl_lc_all_uses_name_value_pairs='define'/d_perl_lc_all_uses_name_value_pairs='undef'/" config.sh -sed -i "s/d_perl_lc_all_separator='undef'/d_perl_lc_all_separator='define'/" config.sh -sed -i 's|^perl_lc_all_separator=.*|perl_lc_all_separator='"'"'";"'"'"'|' config.sh -sed -i "s/d_perl_lc_all_category_positions_init='undef'/d_perl_lc_all_category_positions_init='define'/" config.sh -sed -i "s/^perl_lc_all_category_positions_init=.*/perl_lc_all_category_positions_init='{ 0, 1, 2, 3, 4, 5 }'/" config.sh +perl -pi -e "s/\Ad_perl_lc_all_uses_name_value_pairs=.*/d_perl_lc_all_uses_name_value_pairs='undef'/" config.sh +perl -pi -e "s/\Ad_perl_lc_all_separator=.*/d_perl_lc_all_separator='define'/" config.sh +perl -pi -e "s/\Aperl_lc_all_separator=.*/perl_lc_all_separator=';'/" config.sh +perl -pi -e "s/\Ad_perl_lc_all_category_positions_init=.*/d_perl_lc_all_category_positions_init='define'/" config.sh +perl -pi -e "s/\Aperl_lc_all_category_positions_init=.*/perl_lc_all_category_positions_init='{ 0, 1, 2, 3, 4, 5 }'/" config.sh + +# Fix header/feature detection that failed due to cross-compilation +perl -pi -e "s/\Ai_time=.*/i_time='define'/" config.sh +perl -pi -e "s/\Ai_shadow=.*/i_shadow='undef'/" config.sh +perl -pi -e "s/\Ad_pwpasswd=.*/d_pwpasswd='undef'/" config.sh +perl -pi -e "s/\Ad_pwgecos=.*/d_pwgecos='undef'/" config.sh +perl -pi -e "s/\Ad_grpasswd=.*/d_grpasswd='undef'/" config.sh + +if [ "$OLD_PERL" = 1 ]; then + # Pre-5.20 specific cross-compilation fixes + perl -pi -e "s/\Ai_systime=.*/i_systime='undef'/" config.sh + perl -pi -e "s/\Ai_systimek=.*/i_systimek='undef'/" config.sh + perl -pi -e "s/\Ai_systimes=.*/i_systimes='define'/" config.sh + # Override static_ext to match our version-specific list + perl -pi -e "s|\Astatic_ext=.*|static_ext='$WASI_STATIC_EXT'|" config.sh +fi + sh ./Configure -S +# Perl 5.40+ passes PERL_LC_ALL_SEPARATOR to STRLENs() in locale.c, +# which requires it to be a string literal. Configure generates it as a +# bare semicolon for backward compatibility with older usage patterns. +if [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -ge 40 ]; then + perl -pi -e 's/#define\s+PERL_LC_ALL_SEPARATOR\s+;/#define PERL_LC_ALL_SEPARATOR ";"/' config.h +fi + +# Pre-5.20 post-Configure source fixes +if [ "$OLD_PERL" = 1 ]; then + # Add include guards to proto.h for older Perl versions that lack them + # (prevents duplicate declarations when proto.h is included from multiple places) + if [ -f proto.h ] && ! grep -q 'PERL_PROTO_H_' proto.h 2>/dev/null; then + printf '#ifndef PERL_PROTO_H_\n#define PERL_PROTO_H_\n' | cat - proto.h > proto.h.tmp && mv proto.h.tmp proto.h + echo '#endif /* PERL_PROTO_H_ */' >> proto.h + fi + + # Add missing PERL_ARGS_ASSERT macros for older Perl (5.16.x) + # These are referenced by dquote_static.c but don't exist in the generated headers + if [ -f embed.h ] && ! grep -q 'PERL_ARGS_ASSERT_REGCURLY' embed.h 2>/dev/null; then + echo '#define PERL_ARGS_ASSERT_REGCURLY' >> embed.h + echo '#define PERL_ARGS_ASSERT_GROK_BSLASH_O' >> embed.h + fi + + # Fix setgid/setuid type mismatch: Perl's iperlsys.h passes UV (64-bit) to setgid + # but WASI's gid_t is 32-bit, causing wasm-ld signature mismatch. + if [ -f iperlsys.h ]; then + perl "$REPO_DIR/patches/patch_iperlsys.pl" + fi +fi + # Setup symlinks ln -sf "$PWD/pod/perldelta.pod" . ln -f "$PWD"/README.* .. 2>/dev/null || true -ln -sf "$NATIVE_DIR/generate_uudmap" generate_uudmap # Build -wasimake make -j"$NPROC" utilities PERL="$NATIVE_DIR/miniperl" -wasimake make -j"$NPROC" RUN_PERL="$NATIVE_DIR/miniperl -Ilib -I." -wasimake make install \ No newline at end of file +if [ "$OLD_PERL" = 1 ]; then + if [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -ge 20 ]; then + # Perl 5.20: transitional build — Makefile handles hostperl symlink, + # but needs the same uudmap fixes and Errno stub as older versions. + + # Pre-generate uudmap headers + if [ -x "$NATIVE_DIR/generate_uudmap" ]; then + "$NATIVE_DIR/generate_uudmap" uudmap.h bitcount.h mg_data.h + fi + touch uudmap.h bitcount.h mg_data.h + # Neutralize generate_uudmap build/symlink rules in Makefile + perl -pi -e ' + s|generate_uudmap\$\(HOST_EXE_EXT\)|/build/native/generate_uudmap|g; + $_ = "" if /^\t-\@rm.*generate_uudmap/; + $_ = "" if /\$\(LNS\).*generate_uudmap/; + $_ = "" if /^\t.*\$\(CC\).*generate_uudmap.*-o.*generate_uudmap/; + $_ = "" if m|^/build/native/generate_uudmap:|; + ' Makefile + + # Stub out Errno.pm + mkdir -p ext/Errno/blib/lib ext/Errno/blib/arch + cp "$REPO_DIR/stubs/Errno.pm" ext/Errno/blib/lib/Errno.pm + cp "$REPO_DIR/stubs/Errno.pm" lib/Errno.pm + cat > ext/Errno/Makefile << 'ERRNOMF' +all :: + @: +pure_all :: + @: +clean :: + @: +realclean :: + @: +pm_to_blib :: + @: +ERRNOMF + touch ext/Errno/pm_to_blib + + # Build using host miniperl (Makefile already symlinks it) + wasimake make -j"$NPROC" utilities PERL="$NATIVE_DIR/miniperl" + wasimake make -j"$NPROC" -k RUN_PERL="$NATIVE_DIR/miniperl -Ilib -I." || true + wasimake make -j"$NPROC" perl || true + + # Install + wasimake make -k install || true + if [ ! -d "/zeroperl/lib/$PERL_VERSION" ]; then + echo "make install failed, installing lib manually..." + mkdir -p /zeroperl/lib + cp -r lib /zeroperl/lib/$PERL_VERSION + mkdir -p /zeroperl/lib/$PERL_VERSION/wasm32-wasi + cp lib/Config.pm lib/Config_heavy.pl /zeroperl/lib/$PERL_VERSION/wasm32-wasi/ 2>/dev/null || true + fi + else + # Perl 5.16-5.18: fully manual cross-compilation flow + + # Pre-generate uudmap headers + if [ -x "$NATIVE_DIR/generate_uudmap" ]; then + "$NATIVE_DIR/generate_uudmap" uudmap.h bitcount.h mg_data.h + fi + touch uudmap.h bitcount.h mg_data.h + perl -pi -e ' + s|generate_uudmap\$\(HOST_EXE_EXT\)|/build/native/generate_uudmap|g; + $_ = "" if /^\t-\@rm.*generate_uudmap/; + $_ = "" if /\$\(LNS\).*generate_uudmap/; + $_ = "" if /^\t.*\$\(CC\).*generate_uudmap.*-o.*generate_uudmap/; + $_ = "" if m|^/build/native/generate_uudmap:|; + ' Makefile + + # Build miniperl (WASI target) + wasimake make -j"$NPROC" miniperl + + # Save the WASI miniperl binary before replacing with native + cp miniperl miniperl.wasm + + # Replace WASI miniperl with native miniperl so make steps can run perl scripts + cp "$NATIVE_DIR/miniperl" miniperl + + # Stub out Errno.pm + mkdir -p ext/Errno/blib/lib ext/Errno/blib/arch + cp "$REPO_DIR/stubs/Errno.pm" ext/Errno/blib/lib/Errno.pm + cp "$REPO_DIR/stubs/Errno.pm" lib/Errno.pm + cat > ext/Errno/Makefile << 'ERRNOMF' +all :: + @: +pure_all :: + @: +clean :: + @: +realclean :: + @: +pm_to_blib :: + @: +ERRNOMF + touch ext/Errno/pm_to_blib + + # Build extensions and perl binary (use -k to continue past non-critical failures) + wasimake make -j"$NPROC" -k RUN_PERL="$NATIVE_DIR/miniperl -Ilib -I." || true + wasimake make -j"$NPROC" perl || true + + # Install using native miniperl + wasimake make -k install || true + if [ ! -d "/zeroperl/lib/$PERL_VERSION" ]; then + echo "make install failed, installing lib manually..." + mkdir -p /zeroperl/lib + cp -r lib /zeroperl/lib/$PERL_VERSION + mkdir -p /zeroperl/lib/$PERL_VERSION/wasm32-wasi + cp lib/Config.pm lib/Config_heavy.pl /zeroperl/lib/$PERL_VERSION/wasm32-wasi/ 2>/dev/null || true + fi + fi +else + # Modern Perl (5.22+): use host miniperl for build steps + + ln -sf "$NATIVE_DIR/generate_uudmap" generate_uudmap + + wasimake make -j"$NPROC" utilities PERL="$NATIVE_DIR/miniperl" + wasimake make -j"$NPROC" -k RUN_PERL="$NATIVE_DIR/miniperl -Ilib -I." || true + wasimake make -j"$NPROC" perl || true + + # Install using native miniperl + wasimake make -k install || true + if [ ! -d "/zeroperl/lib/$PERL_VERSION" ]; then + echo "make install failed, installing lib manually..." + mkdir -p /zeroperl/lib + cp -r lib /zeroperl/lib/$PERL_VERSION + mkdir -p /zeroperl/lib/$PERL_VERSION/wasm32-wasi + cp lib/Config.pm lib/Config_heavy.pl /zeroperl/lib/$PERL_VERSION/wasm32-wasi/ 2>/dev/null || true + fi +fi diff --git a/pipeline/build-wasm.sh b/pipeline/build-wasm.sh index a94b3cc..1bc8198 100644 --- a/pipeline/build-wasm.sh +++ b/pipeline/build-wasm.sh @@ -1,20 +1,64 @@ #!/bin/sh set -e +# Compile zeroperl stubs and link the final WASM binary. +# +# Pipeline position: runs after build-wasi-perl.sh. +# Builds the asyncify jump library, compiles zeroperl.c / stubs.c / +# sfs_runtime.c, generates xs_init.inc if missing, and links everything +# into zeroperl.wasm with wasm-opt post-processing (asyncify, strip, etc.). + +PERL_VERSION="${PERL_VERSION:-5.42.2}" +PERL_MAJOR=$(echo "$PERL_VERSION" | cut -d. -f1) +PERL_MINOR=$(echo "$PERL_VERSION" | cut -d. -f2) + +if [ "$PERL_MAJOR" -lt 5 ] || { [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -lt 16 ]; }; then + echo "error: Perl $PERL_VERSION is not supported. Minimum supported version is 5.16.3." >&2 + exit 1 +fi + +# -DNO_MATHOMS exists in 5.20+ +if [ "$PERL_MAJOR" -gt 5 ] || { [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -ge 20 ]; }; then + NO_MATHOMS="-DNO_MATHOMS" +else + NO_MATHOMS="" +fi + WASI_SDK_PATH="${WASI_SDK_PATH:-/opt/wasi-sdk}" WASM_DIR="${WASM_DIR:-/build/wasm}" REPO_DIR="${REPO_DIR:-/build/repo}" STACK_SIZE="${STACK_SIZE:-8388608}" INITIAL_MEMORY="${INITIAL_MEMORY:-33554432}" ASYNCIFY="${ASYNCIFY:-true}" +ZEROPERL_SHRINK="${ZEROPERL_SHRINK:-off}" +ZEROPERL_SFS_COMPRESS="${ZEROPERL_SFS_COMPRESS:-}" +ZEROPERL_EMBED_PREFIX="${ZEROPERL_EMBED_PREFIX:-true}" + +if [ -z "$ZEROPERL_SFS_COMPRESS" ]; then + if [ "$ZEROPERL_SHRINK" = "full" ]; then + ZEROPERL_SFS_COMPRESS="true" + else + ZEROPERL_SFS_COMPRESS="false" + fi +fi + +# Nothing to compress when prefix is not embedded +if [ "$ZEROPERL_EMBED_PREFIX" = "false" ]; then + ZEROPERL_SFS_COMPRESS="false" +fi export PATH="$REPO_DIR/wasi-bin:$PATH" -# Use fake wasm-opt during compile/link to prevent post-link optimization +# wasm-opt is invoked automatically by wasic during linking. We swap in a +# no-op stub so that LTO/link happen quickly; the real wasm-opt pass runs +# later after asyncify instrumentation. mv /opt/binaryen/bin/wasm-opt /opt/binaryen/bin/wasm-opt-real cp "$REPO_DIR/tools/wasm-opt" /opt/binaryen/bin/wasm-opt chmod +x /opt/binaryen/bin/wasm-opt +# --------------------------------------------------------------------------- +# Compile asyncify jump stubs into a static library. +# --------------------------------------------------------------------------- cd "$REPO_DIR/stubs" wasic -flto -O3 -c machine.c -o machine.o wasic -flto -O3 -c runtime.c -o runtime.o @@ -24,23 +68,67 @@ wasic -flto -O3 -c setjmp_core.S -o setjmp_core.o "${WASI_SDK_PATH}/bin/llvm-ar" crs libasyncjmp.a \ machine.o runtime.o setjmp.o machine_core.o setjmp_core.o +# --------------------------------------------------------------------------- +# Copy zeroperl main file and generate xs_init.inc if needed. +# --------------------------------------------------------------------------- cd "$WASM_DIR" cp "$REPO_DIR/stubs/zeroperl.c" . -CFLAGS="-c -O3 -flto -DNO_MATHOMS -D_WASI_EMULATED_PROCESS_CLOCKS -D_WASI_EMULATED_GETPID \ +# xs_init.inc lists the static XS extensions to bootstrap. For non-full +# shrink builds it is generated on-the-fly from the .a files in lib/auto. +# emit-wasm-xs-bundle.pl is the single source of truth for xs_init.inc generation. +if [ ! -f "$REPO_DIR/gen/xs_init.inc" ]; then + ALL_EXTS_FILE=$(mktemp) + find lib/auto -name '*.a' -not -name 'DynaLoader.a' | \ + sed 's|^lib/auto/||; s|/[^/]*\.a$||' | sort -u > "$ALL_EXTS_FILE" + if [ -s "$ALL_EXTS_FILE" ]; then + perl "$REPO_DIR/tools/emit-wasm-xs-bundle.pl" \ + --native-prefix "$WASM_DIR" \ + --static-ext-file "$ALL_EXTS_FILE" \ + --baseline-file "$ALL_EXTS_FILE" \ + --hints-out "$REPO_DIR/gen/hints-static-ext.fragment" \ + --libs-out "$REPO_DIR/gen/wasm-auto-libs.txt" \ + --xs-init-out "$REPO_DIR/gen/xs_init.inc" + fi + rm -f "$ALL_EXTS_FILE" +fi + +# --------------------------------------------------------------------------- +# Compile zeroperl and stub objects. +# --------------------------------------------------------------------------- +CFLAGS="-c -O3 -flto $NO_MATHOMS -D_WASI_EMULATED_PROCESS_CLOCKS -D_WASI_EMULATED_GETPID \ -D_GNU_SOURCE -D_POSIX_C_SOURCE -DBIG_TIME -Wno-implicit-function-declaration \ -Wno-null-pointer-arithmetic -Wno-incomplete-setjmp-declaration -Wno-incompatible-library-redeclaration \ -Wno-int-conversion -D_WASI_EMULATED_SIGNAL \ -include /opt/wasi-sdk/share/wasi-sysroot/include/wasm32-wasi/fcntl.h \ --I. -I$REPO_DIR/stubs -I$REPO_DIR/gen -cxx-isystem /opt/wasi-sdk/share/wasi-sysroot/include" +-I$REPO_DIR/gen -I$REPO_DIR/stubs -I. -cxx-isystem /opt/wasi-sdk/share/wasi-sysroot/include" +if [ -f "$REPO_DIR/gen/xs_init.inc" ]; then + CFLAGS="$CFLAGS -DZEROPERL_USE_GENERATED_XS_INIT" +fi +if [ "$ZEROPERL_SFS_COMPRESS" = "true" ]; then + CFLAGS="$CFLAGS -DZEROPERL_SFS_COMPRESS" +fi wasic $CFLAGS zeroperl.c -o zeroperl.o wasic $CFLAGS "$REPO_DIR/stubs/stubs.c" -o stubs.o +wasic $CFLAGS "$REPO_DIR/stubs/sfs_runtime.c" -o sfs_runtime.o +wasic $CFLAGS "$REPO_DIR/stubs/sfs_compression.c" -o sfs_compression.o +# zeroperl_data.c contains the embedded SFS blob; compile at -O0 so the +# linker does not strip the data section. CFLAGS_DATA="-c -O0 -std=c23 \ --I. -I$REPO_DIR/stubs -I$REPO_DIR/gen -cxx-isystem /opt/wasi-sdk/share/wasi-sysroot/include" +-I$REPO_DIR/gen -I$REPO_DIR/stubs -I. -cxx-isystem /opt/wasi-sdk/share/wasi-sysroot/include" wasic $CFLAGS_DATA "$REPO_DIR/gen/zeroperl_data.c" -o zeroperl_data.o +GENERATED_AUTO_LIBS="" +# Discover .a files dynamically so the list matches what was actually built +# for the target Perl version. +DEFAULT_AUTO_LIBS=$(find lib/auto -name '*.a' -not -name 'DynaLoader.a' | sort | tr '\n' ' ') +if [ "$ZEROPERL_SHRINK" = "full" ] && [ -f "$REPO_DIR/gen/wasm-auto-libs.txt" ]; then + GENERATED_AUTO_LIBS=$(tr '\n' ' ' < "$REPO_DIR/gen/wasm-auto-libs.txt") +fi +AUTO_LIBS="${GENERATED_AUTO_LIBS:-$DEFAULT_AUTO_LIBS}" + wasic \ -o zeroperl_reactor.wasm \ -flto -g \ @@ -55,7 +143,7 @@ wasic \ -Wl,--export=__table_base \ -Wl,--export=malloc \ -Wl,--export=free \ - -DNO_MATHOMS \ + $NO_MATHOMS \ -D_WASI_EMULATED_PROCESS_CLOCKS -lwasi-emulated-process-clocks \ -D_WASI_EMULATED_GETPID -lwasi-emulated-getpid \ -D_GNU_SOURCE -D_POSIX_C_SOURCE \ @@ -63,53 +151,22 @@ wasic \ -D_WASI_EMULATED_SIGNAL -lwasi-emulated-signal \ -lwasi-emulated-mman \ -Wl,--strip-all \ - zeroperl.o stubs.o zeroperl_data.o \ + zeroperl.o stubs.o sfs_runtime.o sfs_compression.o zeroperl_data.o \ -Wl,--whole-archive "$REPO_DIR/stubs/libasyncjmp.a" -Wl,--no-whole-archive \ -Wl,--whole-archive libperl.a -Wl,--no-whole-archive \ -Wl,--wrap=fopen -Wl,--wrap=open -Wl,--wrap=close -Wl,--wrap=read \ -Wl,--wrap=lseek -Wl,--wrap=stat -Wl,--wrap=fstat \ - lib/auto/File/Glob/Glob.a \ - lib/auto/Sys/Hostname/Hostname.a \ - lib/auto/PerlIO/via/via.a \ - lib/auto/PerlIO/mmap/mmap.a \ - lib/auto/PerlIO/encoding/encoding.a \ - lib/auto/attributes/attributes.a \ - lib/auto/Unicode/Normalize/Normalize.a \ - lib/auto/Unicode/Collate/Collate.a \ - lib/auto/re/re.a \ - lib/auto/Digest/MD5/MD5.a \ - lib/auto/Digest/SHA/SHA.a \ - lib/auto/Math/BigInt/FastCalc/FastCalc.a \ - lib/auto/Data/Dumper/Dumper.a \ - lib/auto/I18N/Langinfo/Langinfo.a \ - lib/auto/Time/Piece/Piece.a \ - lib/auto/IO/IO.a \ - lib/auto/Hash/Util/FieldHash/FieldHash.a \ - lib/auto/Hash/Util/Util.a \ - lib/auto/Filter/Util/Call/Call.a \ - lib/auto/Encode/Unicode/Unicode.a \ - lib/auto/Encode/Encode.a \ - lib/auto/Encode/JP/JP.a \ - lib/auto/Encode/KR/KR.a \ - lib/auto/Encode/EBCDIC/EBCDIC.a \ - lib/auto/Encode/CN/CN.a \ - lib/auto/Encode/Symbol/Symbol.a \ - lib/auto/Encode/Byte/Byte.a \ - lib/auto/Encode/TW/TW.a \ - lib/auto/Compress/Raw/Zlib/Zlib.a \ - lib/auto/Compress/Raw/Bzip2/Bzip2.a \ - lib/auto/MIME/Base64/Base64.a \ - lib/auto/Cwd/Cwd.a \ - lib/auto/List/Util/Util.a \ - lib/auto/Fcntl/Fcntl.a \ - lib/auto/Opcode/Opcode.a \ - lib/auto/Time/HiRes/HiRes.a \ + $AUTO_LIBS \ $(cat ext.libs) \ - -lz -lbz2 \ + -lz -lbz2 -llz4 \ -lm -lwasi-emulated-signal -lwasi-emulated-getpid \ -lwasi-emulated-process-clocks -lwasi-emulated-mman \ -ferror-limit=0 +# --------------------------------------------------------------------------- +# Link the final reactor WASM, then run wasm-opt (asyncify + strip). +# --------------------------------------------------------------------------- + # Restore real wasm-opt for asyncify pass mv /opt/binaryen/bin/wasm-opt-real /opt/binaryen/bin/wasm-opt diff --git a/pipeline/hints-wasi.sh b/pipeline/hints-wasi.sh index c9d4e7e..334e677 100644 --- a/pipeline/hints-wasi.sh +++ b/pipeline/hints-wasi.sh @@ -1,5 +1,11 @@ -# WASI hints for Perl cross-compilation -# Based on actual WASM32 type sizes from wasi-sdk +# WASI hints for Perl cross-compilation. +# +# This file is consumed by build-wasi-perl.sh, which substitutes +# placeholders (__WASI_SDK_PATH__, __NATIVE_DIR__, etc.) and appends +# version-specific overrides before passing it to Perl's Configure +# as -Dhintfile=wasi. +# +# Based on actual WASM32 type sizes from wasi-sdk. # Architecture osname='wasi' @@ -43,6 +49,12 @@ perl_lc_all_separator=';' d_perl_lc_all_category_positions_init='define' perl_lc_all_category_positions_init='{ 0, 1, 2, 3, 4, 5 }' +# Void support (modern compilers all support void) +voidflags='15' + +# Header availability (cross-compilation can't detect these) +i_time='define' + # Memory/threading usemymalloc='n' usemultiplicity='undef' @@ -204,7 +216,7 @@ d_readdir64_r='undef' noextensions='Socket POSIX Devel/Peek Sys/Syslog B threads threads/shared IPC/SysV SDBM_File Storable File/DosGlob' # Static extensions to build -static_ext='mro Time/HiRes File/Glob Sys/Hostname PerlIO/via PerlIO/mmap PerlIO/encoding attributes Unicode/Normalize Unicode/Collate re Digest/MD5 Digest/SHA Math/BigInt/FastCalc Data/Dumper I18N/Langinfo Time/Piece IO Hash/Util/FieldHash Hash/Util Filter/Util/Call Encode/Unicode Encode Encode/JP Encode/KR Encode/EBCDIC Encode/CN Encode/Symbol Encode/Byte Encode/TW Compress/Raw/Zlib Compress/Raw/Bzip2 MIME/Base64 Cwd List/Util Fcntl Opcode' +static_ext='mro Time/HiRes File/Glob Sys/Hostname PerlIO/via PerlIO/mmap PerlIO/encoding attributes Unicode/Collate re Digest/MD5 Digest/SHA Math/BigInt/FastCalc Data/Dumper I18N/Langinfo Time/Piece IO Hash/Util/FieldHash Hash/Util Filter/Util/Call Encode/Unicode Encode Encode/JP Encode/KR Encode/EBCDIC Encode/CN Encode/Symbol Encode/Byte Encode/TW Compress/Raw/Zlib Compress/Raw/Bzip2 MIME/Base64 Cwd List/Util Fcntl Opcode' # Compiler/linker flags ccflags='-DBIG_TIME -DNO_MATHOMS -Wno-int-conversion -Wno-implicit-function-declaration -D_WASI_EMULATED_PROCESS_CLOCKS -D_WASI_EMULATED_GETPID -D_GNU_SOURCE -D_POSIX_C_SOURCE -Wno-null-pointer-arithmetic -D_WASI_EMULATED_SIGNAL -include __WASI_SDK_PATH__/share/wasi-sysroot/include/wasm32-wasi/fcntl.h -I__STUBS_DIR__' @@ -213,4 +225,4 @@ cppflags='-DBIG_TIME -DNO_MATHOMS -Wno-int-conversion -Wno-implicit-function-dec ldflags='-static -lwasi-emulated-signal -lwasi-emulated-getpid -lwasi-emulated-process-clocks -lwasi-emulated-mman' -libs='-lm -lwasi-emulated-signal -lwasi-emulated-getpid -lwasi-emulated-process-clocks -lwasi-emulated-mman' \ No newline at end of file +libs='-lm -lwasi-emulated-signal -lwasi-emulated-getpid -lwasi-emulated-process-clocks -lwasi-emulated-mman' diff --git a/pipeline/prepare-prefix.sh b/pipeline/prepare-prefix.sh index d7f378d..abeebae 100644 --- a/pipeline/prepare-prefix.sh +++ b/pipeline/prepare-prefix.sh @@ -1,34 +1,147 @@ #!/bin/sh set -e -PERL_VERSION="${PERL_VERSION:-5.42.0}" +# Post-process the installed Perl prefix (/zeroperl) for embedding into +# the WASM binary as a Single File System (SFS). +# +# Pipeline position: runs after build-wasi-perl.sh and optionally +# build-exiftool.sh. +# Tasks: +# - Copy ExifTool site-lib files into the prefix (if built) +# - Strip binaries, .so, .a, .pod, and headers +# - Remove dead code via delete.js (tools/delete.txt manifest) +# - Restore unicore/Heavy.pl for Perl < 5.18 if needed +# - Install File::Glob shim if missing +# - Strip unicore tables for full-shrink builds +# - Run perltidy over all .pm/.pl files (optional TRIM step) +# - Generate the SFS header (zeroperl.h) via sfs.js + +PERL_VERSION="${PERL_VERSION:-5.42.2}" BUILD_EXIFTOOL="${BUILD_EXIFTOOL:-true}" TRIM="${TRIM:-true}" NATIVE_DIR="${NATIVE_DIR:-/build/native}" REPO_DIR="${REPO_DIR:-/build/repo}" NPROC="${NPROC:-$(nproc)}" +ZEROPERL_SHRINK="${ZEROPERL_SHRINK:-off}" +ZEROPERL_SFS_COMPRESS="${ZEROPERL_SFS_COMPRESS:-}" +ZEROPERL_EMBED_PREFIX="${ZEROPERL_EMBED_PREFIX:-true}" + +if [ -z "$ZEROPERL_SFS_COMPRESS" ]; then + if [ "$ZEROPERL_SHRINK" = "full" ]; then + ZEROPERL_SFS_COMPRESS="true" + else + ZEROPERL_SFS_COMPRESS="false" + fi +fi rm -rf /zeroperl/bin find /zeroperl -type f \( -name "*.so" -o -name "*.a" -o -name "*.ld" -o -name "*.pod" -o -name "*.h" -o -executable \) -delete +copy_traced_site_files() { + list_file="$1" + site_root="$2" + while IFS= read -r relpath; do + [ -n "$relpath" ] || continue + case "$relpath" in + "lib/$PERL_VERSION/wasm32-wasi/"*) + src_rel=${relpath#lib/$PERL_VERSION/wasm32-wasi/} + src_path="$site_root/$src_rel" + dst_path="/zeroperl/$relpath" + [ -f "$src_path" ] || continue + mkdir -p "$(dirname "$dst_path")" + cp "$src_path" "$dst_path" + ;; + esac + done < "$list_file" +} + if [ "$BUILD_EXIFTOOL" = "true" ]; then SITE_PERL="$NATIVE_DIR/prefix/lib/perl5/site_perl/$PERL_VERSION" mkdir -p "/zeroperl/lib/$PERL_VERSION/wasm32-wasi/File" mkdir -p "/zeroperl/lib/$PERL_VERSION/wasm32-wasi/Image" - cp -R "$SITE_PERL/File/"* "/zeroperl/lib/$PERL_VERSION/wasm32-wasi/File/" 2>/dev/null || true - cp -R "$SITE_PERL/Image/"* "/zeroperl/lib/$PERL_VERSION/wasm32-wasi/Image/" + if [ "$ZEROPERL_SHRINK" = "off" ]; then + cp -R "$SITE_PERL/File/"* "/zeroperl/lib/$PERL_VERSION/wasm32-wasi/File/" 2>/dev/null || true + cp -R "$SITE_PERL/Image/"* "/zeroperl/lib/$PERL_VERSION/wasm32-wasi/Image/" + else + if [ ! -s "$REPO_DIR/gen/traced-files.txt" ]; then + echo "error: missing or empty traced file list: $REPO_DIR/gen/traced-files.txt" >&2 + exit 1 + fi + rm -rf "/zeroperl/lib/$PERL_VERSION/wasm32-wasi/File" "/zeroperl/lib/$PERL_VERSION/wasm32-wasi/Image" + mkdir -p "/zeroperl/lib/$PERL_VERSION/wasm32-wasi/File" "/zeroperl/lib/$PERL_VERSION/wasm32-wasi/Image" + copy_traced_site_files "$REPO_DIR/gen/traced-files.txt" "$SITE_PERL" + fi fi node "$REPO_DIR/tools/delete.js" "$REPO_DIR/tools/delete.txt" /zeroperl "$PERL_VERSION" +# unicore/Heavy.pl is required by utf8_heavy.pl -> constant.pm on Perl < 5.18. +# delete.js removes the entire unicore directory, but Heavy.pl must be +# restored for versions where it shipped in core. +# Perl 5.18+ restructured unicore and no longer has Heavy.pl. +PERL_MAJOR=$(echo "$PERL_VERSION" | cut -d. -f1) +PERL_MINOR=$(echo "$PERL_VERSION" | cut -d. -f2) +if [ "$PERL_MAJOR" -eq 5 ] && [ "$PERL_MINOR" -lt 18 ]; then + HEAVY_SRC="$WASM_DIR/lib/$PERL_VERSION/unicore/Heavy.pl" + if [ -f "$HEAVY_SRC" ]; then + mkdir -p "/zeroperl/lib/$PERL_VERSION/unicore" + cp "$HEAVY_SRC" "/zeroperl/lib/$PERL_VERSION/unicore/Heavy.pl" + echo "Restored unicore/Heavy.pl for Perl $PERL_VERSION" + fi +fi + +if [ -f "$REPO_DIR/tools/file-glob-shim.pm" ] && \ + [ ! -f "/zeroperl/lib/$PERL_VERSION/wasm32-wasi/File/Glob.pm" ] && \ + [ ! -f "/zeroperl/lib/$PERL_VERSION/File/Glob.pm" ]; then + mkdir -p "/zeroperl/lib/$PERL_VERSION/wasm32-wasi/File" + cp "$REPO_DIR/tools/file-glob-shim.pm" \ + "/zeroperl/lib/$PERL_VERSION/wasm32-wasi/File/Glob.pm" +fi + +if [ "$ZEROPERL_SHRINK" = "full" ] && [ -x "$REPO_DIR/tools/unicore-strip.pl" ]; then + perl "$REPO_DIR/tools/unicore-strip.pl" "/zeroperl/lib/$PERL_VERSION" +fi + if [ "$TRIM" = "true" ]; then export PATH="$NATIVE_DIR/prefix/bin:$PATH" find /zeroperl -type f \( -name '*.pl' -o -name '*.pm' \) -exec chmod u+w {} \; - find /zeroperl -type f \( -name '*.pl' -o -name '*.pm' \) -print0 | \ - xargs -0 -P "$NPROC" -I {} sh -c \ - "perltidy --delete-block-comments --delete-side-comments --delete-pod --backup-and-modify-in-place --backup-file-extension='/' '{}'" + SKIP_FILE="$REPO_DIR/tools/perltidy-skip.txt" + TIDY_LIST="$(mktemp)" + find /zeroperl -type f \( -name '*.pl' -o -name '*.pm' \) | sort > "$TIDY_LIST" + while IFS= read -r file; do + rel="${file#/zeroperl/}" + skip="" + if [ -f "$SKIP_FILE" ]; then + while IFS= read -r pattern; do + case "$pattern" in + ''|\#*) continue ;; + esac + case "$rel" in + $pattern) skip=1; break ;; + esac + done < "$SKIP_FILE" + fi + [ -z "$skip" ] || continue + if ! perltidy --noprofile --mangle --delete-all-comments \ + --backup-and-modify-in-place --backup-file-extension='/' "$file"; then + echo "error: perltidy failed for $file" >&2 + rm -f "$TIDY_LIST" + exit 1 + fi + done < "$TIDY_LIST" + rm -f "$TIDY_LIST" fi mkdir -p "$REPO_DIR/gen" -node "$REPO_DIR/tools/sfs.js" -i /zeroperl -o "$REPO_DIR/gen/zeroperl.h" --prefix /zeroperl +if [ "$ZEROPERL_EMBED_PREFIX" = "false" ]; then + echo "ZEROPERL_EMBED_PREFIX=false: generating empty SFS (no embedded prefix)" + node "$REPO_DIR/tools/sfs.js" --empty -o "$REPO_DIR/gen/zeroperl.h" --prefix /zeroperl + exit 0 +fi + +SFS_COMPRESS_FLAG="" +if [ "$ZEROPERL_SFS_COMPRESS" = "true" ]; then + SFS_COMPRESS_FLAG="--compress" +fi +node "$REPO_DIR/tools/sfs.js" -i /zeroperl -o "$REPO_DIR/gen/zeroperl.h" --prefix /zeroperl $SFS_COMPRESS_FLAG diff --git a/stubs/Errno.pm b/stubs/Errno.pm new file mode 100644 index 0000000..df1f137 --- /dev/null +++ b/stubs/Errno.pm @@ -0,0 +1,72 @@ +package Errno; + +use strict; +use Exporter 'import'; + +our @EXPORT_OK = qw(EPERM ENOENT ESRCH EINTR EIO ENXIO E2BIG ENOEXEC EBADF ECHILD EAGAIN ENOMEM EACCES EFAULT ENOTBLK EBUSY EEXIST EXDEV ENODEV ENOTDIR EISDIR EINVAL ENFILE EMFILE ENOTTY ETXTBSY EFBIG ENOSPC ESPIPE EROFS EMLINK EPIPE EDOM ERANGE ENOMSG EIDRM ECHRNG EL2NSYNC EL3HLT EL3RST ELNRNG EUNATCH ENOCSI EL2HLT EDEADLK ENOLCK ENOSTR ENODATA ETIME ENOSR ENONET ENOPKG EREMOTE ENOLINK EADV ESRMNT ECOMM EPROTO EMULTIHOP EBADMSG ENAMETOOLONG EOVERFLOW ENOTUNIQ EBADFD EREMCHG ELIBACC ELIBBAD ELIBSCN ELIBMAX ELIBEXEC EILSEQ ERESTART ESTRPIPE EUSERS ENOTSOCK EDESTADDRREQ EMSGSIZE EPROTOTYPE ENOPROTOOPT EPROTONOSUPPORT ESOCKTNOSUPPORT EOPNOTSUPP EPFNOSUPPORT EAFNOSUPPORT EADDRINUSE EADDRNOTAVAIL ENETDOWN ENETUNREACH ENETRESET ECONNABORTED ECONNRESET ENOBUFS EISCONN ENOTCONN ESHUTDOWN ETIMEDOUT ECONNREFUSED EHOSTDOWN EHOSTUNREACH EALREADY EINPROGRESS ESTALE EUCLEAN ENOTNAM ENAVAIL EISNAM EREMOTEIO EDQUOT ENOMEDIUM EMEDIUMTYPE ECANCELED ENOKEY EKEYEXPIRED EKEYREVOKED EKEYREJECTED EOWNERDEAD ENOTRECOVERABLE ERFKILL EHWPOISON EWOULDBLOCK ENOTSUP); + +our %EXPORT_TAGS = (POSIX => [@EXPORT_OK]); + +# Static errno values for WASI +my %E = ( + EPERM => 1, ENOENT => 2, ESRCH => 3, EINTR => 4, EIO => 5, + ENXIO => 6, E2BIG => 7, ENOEXEC => 8, EBADF => 9, ECHILD => 10, + EAGAIN => 11, ENOMEM => 12, EACCES => 13, EFAULT => 14, ENOTBLK => 15, + EBUSY => 16, EEXIST => 17, EXDEV => 18, ENODEV => 19, ENOTDIR => 20, + EISDIR => 21, EINVAL => 22, ENFILE => 23, EMFILE => 24, ENOTTY => 25, + ETXTBSY => 26, EFBIG => 27, ENOSPC => 28, ESPIPE => 29, EROFS => 30, + EMLINK => 31, EPIPE => 32, EDOM => 33, ERANGE => 34, + ENOMSG => 35, EIDRM => 36, ECHRNG => 37, EL2NSYNC => 38, + EL3HLT => 39, EL3RST => 40, ELNRNG => 41, EUNATCH => 42, + ENOCSI => 43, EL2HLT => 44, EDEADLK => 45, ENOLCK => 46, + ENOSTR => 47, ENODATA => 48, ETIME => 49, ENOSR => 50, + ENONET => 51, ENOPKG => 52, EREMOTE => 53, ENOLINK => 54, + EADV => 55, ESRMNT => 56, ECOMM => 57, EPROTO => 58, + EMULTIHOP => 59, EBADMSG => 60, ENAMETOOLONG => 61, + EOVERFLOW => 62, ENOTUNIQ => 63, EBADFD => 64, + EREMCHG => 65, ELIBACC => 66, ELIBBAD => 67, ELIBSCN => 68, + ELIBMAX => 69, ELIBEXEC => 70, EILSEQ => 71, + ERESTART => 72, ESTRPIPE => 73, EUSERS => 74, + ENOTSOCK => 75, EDESTADDRREQ => 76, EMSGSIZE => 77, + EPROTOTYPE => 78, ENOPROTOOPT => 79, EPROTONOSUPPORT => 80, + ESOCKTNOSUPPORT => 81, EOPNOTSUPP => 82, EPFNOSUPPORT => 83, + EAFNOSUPPORT => 84, EADDRINUSE => 85, EADDRNOTAVAIL => 86, + ENETDOWN => 87, ENETUNREACH => 88, ENETRESET => 89, + ECONNABORTED => 90, ECONNRESET => 91, ENOBUFS => 92, + EISCONN => 93, ENOTCONN => 94, ESHUTDOWN => 95, + ETIMEDOUT => 96, ECONNREFUSED => 97, EHOSTDOWN => 98, + EHOSTUNREACH => 99, EALREADY => 100, EINPROGRESS => 101, + ESTALE => 102, EUCLEAN => 103, ENOTNAM => 104, + ENAVAIL => 105, EISNAM => 106, EREMOTEIO => 107, + EDQUOT => 108, ENOMEDIUM => 109, EMEDIUMTYPE => 110, + ECANCELED => 111, ENOKEY => 112, EKEYEXPIRED => 113, + EKEYREVOKED => 114, EKEYREJECTED => 115, EOWNERDEAD => 116, + ENOTRECOVERABLE => 117, ERFKILL => 118, EHWPOISON => 119, + EWOULDBLOCK => 11, ENOTSUP => 82, +); + +sub TIEHASH { bless {}, $_[0] } +sub FETCH { $E{$_[1]} } +sub STORE { $E{$_[1]} = $_[2] } +sub DELETE { delete $E{$_[1]} } +sub EXISTS { exists $E{$_[1]} } +sub FIRSTKEY { my $a = scalar keys %E; each %E } +sub NEXTKEY { each %E } + +tie our %!, __PACKAGE__; + +sub import { + my $pkg = shift; + for my $sym (@_) { + if ($sym eq ':POSIX') { + require Exporter; + Exporter::export_to_level($pkg, 1, undef, @EXPORT_OK); + } elsif (exists $E{$sym}) { + my $val = $E{$sym}; + no strict 'refs'; + *{caller()."::$sym"} = sub () { $val }; + } + } +} + +1; diff --git a/stubs/runtime.c b/stubs/runtime.c index b1a0f7d..aa300d6 100644 --- a/stubs/runtime.c +++ b/stubs/runtime.c @@ -5,8 +5,8 @@ int asyncjmp_rt_start(int(main)(int argc, char **argv), int argc, char **argv) { - int result; - void *asyncify_buf; + int result = 0; + void *asyncify_buf = NULL; while (1) { @@ -24,12 +24,14 @@ int asyncjmp_rt_start(int(main)(int argc, char **argv), int argc, char **argv) // unwind check here and it unwinds to the root frame. asyncify_stop_unwind(); - if ((asyncify_buf = asyncjmp_handle_jmp_unwind()) != NULL) + asyncify_buf = asyncjmp_handle_jmp_unwind(); + if (asyncify_buf != NULL) { asyncify_start_rewind(asyncify_buf); continue; } - if ((asyncify_buf = asyncjmp_handle_scan_unwind()) != NULL) + asyncify_buf = asyncjmp_handle_scan_unwind(); + if (asyncify_buf != NULL) { asyncify_start_rewind(asyncify_buf); continue; diff --git a/stubs/setjmp.c b/stubs/setjmp.c index a7c6456..5246c69 100644 --- a/stubs/setjmp.c +++ b/stubs/setjmp.c @@ -123,13 +123,13 @@ __attribute__((noinline)) int _asyncjmp_setjmp_internal(asyncjmp_jmp_buf *env) return 0; } -void _asyncjmp_longjmp(asyncjmp_jmp_buf *env, int value) +void _asyncjmp_longjmp(asyncjmp_jmp_buf *env, int payload) { ASYNCJMP_DEBUG_LOG("enter _asyncjmp_longjmp"); assert(env->state == JMP_BUF_STATE_CAPTURED); - assert(value != 0); + assert(payload != 0); env->state = JMP_BUF_STATE_RETURNING; - env->payload = value; + env->payload = payload; // Asyncify buffer built during unwinding for longjmp will not // be used to rewind, so re-use static-variable. static struct __asyncjmp_asyncify_jmp_buf tmp_longjmp_buf; @@ -147,7 +147,8 @@ enum try_catch_phase void asyncjmp_try_catch_init(struct asyncjmp_try_catch *try_catch, asyncjmp_try_catch_func_t try_f, - asyncjmp_try_catch_func_t catch_f, void *context) + void *context, + asyncjmp_try_catch_func_t catch_f) { try_catch->state = TRY_CATCH_PHASE_MAIN; try_catch->try_f = try_f; @@ -163,7 +164,6 @@ void asyncjmp_try_catch_loop_run(struct asyncjmp_try_catch *try_catch, asyncjmp_jmp_buf *target) { extern void *pl_asyncify_unwind_buf; - extern asyncjmp_jmp_buf *_asyncjmp_active_jmpbuf; target->state = JMP_BUF_STATE_CAPTURED; diff --git a/stubs/setjmp.h b/stubs/setjmp.h index 6c07168..3ddbb9f 100644 --- a/stubs/setjmp.h +++ b/stubs/setjmp.h @@ -3,6 +3,9 @@ #include + +// Keep context between try/catch callbacks so two adjacent function-pointer +// parameters are not easily swapped at call sites. #ifndef WASM_SETJMP_STACK_BUFFER_SIZE #define WASM_SETJMP_STACK_BUFFER_SIZE 32768 #endif @@ -34,7 +37,7 @@ typedef struct __attribute__((noinline)) int _asyncjmp_setjmp(asyncjmp_jmp_buf *env); __attribute__((noinline)) void _asyncjmp_longjmp(asyncjmp_jmp_buf *env, int payload); -#define asyncjmp_setjmp(env) ((env).state = 0, _asyncjmp_setjmp(&(env))) +#define asyncjmp_setjmp(env) (((env).state = 0), _asyncjmp_setjmp(&(env))) // NOTE: Why is `_asyncjmp_longjmp` not `noreturn`? Why put `unreachable` in the call site? // Asyncify expects that `_asyncjmp_longjmp` returns its control, and Asyncify inserts a return @@ -43,7 +46,7 @@ __attribute__((noinline)) void _asyncjmp_longjmp(asyncjmp_jmp_buf *env, int payl // On the other hand, `noreturn` means the callee won't return its control to the caller, // so compiler can assume that a function with the attribute won't reach the end of the function. // Therefore `_asyncjmp_longjmp`'s semantics is not exactly same as `noreturn`. -#define asyncjmp_longjmp(env, payload) (_asyncjmp_longjmp(&env, payload), __builtin_unreachable()) +#define asyncjmp_longjmp(env, payload) (_asyncjmp_longjmp(&(env), (payload)), __builtin_unreachable()) // Returns the Asyncify buffer of next rewinding if unwound for setjmp capturing or longjmp. // Used by the top level Asyncify handling in wasm/runtime.c @@ -75,8 +78,8 @@ struct asyncjmp_try_catch void asyncjmp_try_catch_init(struct asyncjmp_try_catch *try_catch, asyncjmp_try_catch_func_t try_f, - asyncjmp_try_catch_func_t catch_f, - void *context); + void *context, + asyncjmp_try_catch_func_t catch_f); // Run, catch longjmp thrown by run, and re-catch longjmp thrown by catch, ... // diff --git a/stubs/sfs_compression.c b/stubs/sfs_compression.c new file mode 100644 index 0000000..f3a2720 --- /dev/null +++ b/stubs/sfs_compression.c @@ -0,0 +1,201 @@ +#include "sfs_compression.h" + +#include "sfs_lz4.h" +#if __has_include("zeroperl.h") +#include "zeroperl.h" +#else +struct sfs_entry { + const char *abspath; + const unsigned char *start; + const unsigned char *end; + uint32_t decompressed_size; + uint8_t codec; +}; +#endif + +#include +#include +#include + +static size_t sfs_cache_evict_one(SfsCache *cache); + +static int sfs_cache_find_slot(const SfsCache *cache) { + for (int i = 0; i < SFS_LRU_MAX; i++) { + if (!cache->entries[i].abspath) { + return i; + } + } + return -1; +} + +static SfsLruEntry *sfs_cache_lookup(SfsCache *cache, const char *abspath) { + // Cache keys are canonicalized absolute paths; string equality is required + // because callers may provide distinct pointers with identical content. + for (int i = 0; i < SFS_LRU_MAX; i++) { + if (cache->entries[i].abspath && + strcmp(cache->entries[i].abspath, abspath) == 0) { + return &cache->entries[i]; + } + } + return NULL; +} + +static bool sfs_cache_prepare_slot(SfsCache *cache, size_t decomp_size, + int *slot) { + // If the entry cannot fit under the byte cap or all candidates are pinned, + // caller will fall back to transient (non-cached) ownership. + if (decomp_size > SFS_LRU_CAP_BYTES) { + return false; + } + + while (cache->bytes + decomp_size > SFS_LRU_CAP_BYTES) { + if (sfs_cache_evict_one(cache) == 0) { + return false; + } + } + + *slot = sfs_cache_find_slot(cache); + while (*slot < 0) { + if (sfs_cache_evict_one(cache) == 0) { + return false; + } + *slot = sfs_cache_find_slot(cache); + } + + return true; +} + +static int sfs_decompress_alloc(const struct sfs_entry *entry, + unsigned char **out_buf, + size_t *out_size) { + size_t comp_size = (size_t)(entry->end - entry->start); + size_t decomp_size = (size_t)entry->decompressed_size; + + unsigned char *buf = (unsigned char *)malloc(decomp_size); + if (!buf) { + errno = ENOMEM; + return -1; + } + + if (sfs_lz4_decompress_frame(entry->start, comp_size, buf, decomp_size) != 0) { + free(buf); + return -1; + } + + *out_buf = buf; + *out_size = decomp_size; + return 0; +} + +static size_t sfs_cache_evict_one(SfsCache *cache) { + uint64_t oldest = UINT64_MAX; + int victim = -1; + for (int i = 0; i < SFS_LRU_MAX; i++) { + if (cache->entries[i].abspath && cache->entries[i].refcount == 0) { + if (cache->entries[i].lru_tick < oldest) { + oldest = cache->entries[i].lru_tick; + victim = i; + } + } + } + if (victim < 0) { + return 0; + } + size_t freed = cache->entries[victim].size; + free(cache->entries[victim].data); + cache->entries[victim] = (SfsLruEntry){0}; + cache->bytes -= freed; + return freed; +} + +void sfs_cache_init(SfsCache *cache) { + memset(cache, 0, sizeof(*cache)); +} + +void sfs_cache_dispose(SfsCache *cache) { + for (int i = 0; i < SFS_LRU_MAX; i++) { + free(cache->entries[i].data); + cache->entries[i] = (SfsLruEntry){0}; + } + cache->bytes = 0; + cache->clock = 0; +} + +size_t sfs_entry_effective_size(const struct sfs_entry *entry) { + if (entry->codec == 1) { + return (size_t)entry->decompressed_size; + } + return (size_t)(entry->end - entry->start); +} + +int sfs_entry_materialize(SfsCache *cache, const struct sfs_entry *entry, + const unsigned char **data_start, + size_t *data_size, + SfsLruEntry **cache_handle, + unsigned char **owned_data) { + if (cache_handle) { + *cache_handle = NULL; + } + if (owned_data) { + *owned_data = NULL; + } + + if (entry->codec != 1) { + *data_start = entry->start; + *data_size = (size_t)(entry->end - entry->start); + return 0; + } + + SfsLruEntry *cached = sfs_cache_lookup(cache, entry->abspath); + if (cached) { + cached->lru_tick = ++cache->clock; + cached->refcount++; + *data_start = cached->data; + *data_size = cached->size; + if (cache_handle) { + *cache_handle = cached; + } + return 0; + } + + size_t decomp_size = (size_t)entry->decompressed_size; + int slot = -1; + bool can_cache = sfs_cache_prepare_slot(cache, decomp_size, &slot); + + unsigned char *buf = NULL; + size_t out_size = 0; + if (sfs_decompress_alloc(entry, &buf, &out_size) != 0) { + return -1; + } + + if (!can_cache) { + *data_start = buf; + *data_size = out_size; + if (owned_data) { + *owned_data = buf; + } + return 0; + } + + cache->entries[slot] = (SfsLruEntry){ + .abspath = entry->abspath, + .data = buf, + .size = out_size, + .refcount = 1, + .lru_tick = ++cache->clock, + }; + cache->bytes += out_size; + + *data_start = cache->entries[slot].data; + *data_size = cache->entries[slot].size; + if (cache_handle) { + *cache_handle = &cache->entries[slot]; + } + return 0; +} + +void sfs_cache_release(SfsLruEntry *entry) { + if (entry && entry->refcount > 0) { + entry->refcount--; + } +} \ No newline at end of file diff --git a/stubs/sfs_compression.h b/stubs/sfs_compression.h new file mode 100644 index 0000000..86b98f4 --- /dev/null +++ b/stubs/sfs_compression.h @@ -0,0 +1,44 @@ +#ifndef ZEROPERL_SFS_COMPRESSION_H +#define ZEROPERL_SFS_COMPRESSION_H + +#include +#include + +struct sfs_entry; + +typedef struct SfsLruEntry { + const char *abspath; + unsigned char *data; + size_t size; + int refcount; + uint64_t lru_tick; +} SfsLruEntry; + +#ifndef SFS_LRU_MAX +#define SFS_LRU_MAX 4096 +#endif + +#ifndef SFS_LRU_CAP_BYTES +#define SFS_LRU_CAP_BYTES ((size_t)20u * 1024u * 1024u) +#endif + +typedef struct SfsCache { + SfsLruEntry entries[SFS_LRU_MAX]; + size_t bytes; + uint64_t clock; +} SfsCache; + +void sfs_cache_init(SfsCache *cache); +void sfs_cache_dispose(SfsCache *cache); + +int sfs_entry_materialize(SfsCache *cache, const struct sfs_entry *entry, + const unsigned char **data_start, + size_t *data_size, + SfsLruEntry **cache_handle, + unsigned char **owned_data); + +void sfs_cache_release(SfsLruEntry *entry); + +size_t sfs_entry_effective_size(const struct sfs_entry *entry); + +#endif \ No newline at end of file diff --git a/stubs/sfs_lz4.h b/stubs/sfs_lz4.h new file mode 100644 index 0000000..ff3270e --- /dev/null +++ b/stubs/sfs_lz4.h @@ -0,0 +1,145 @@ +#ifndef ZEROPERL_SFS_LZ4_H +#define ZEROPERL_SFS_LZ4_H + +#include +#include +#include + +#include + +typedef struct { + const unsigned char *srcp; + size_t src_rem; + unsigned char *dstp; + size_t dst_rem; +} SfsLz4State; + +// Centralized failure path keeps EIO policy and context cleanup consistent. +static inline int sfs_lz4_fail(LZ4F_dctx *ctx) { + LZ4F_freeDecompressionContext(ctx); + errno = EIO; + return -1; +} + +// Phase 1 writes directly into the destination buffer until either the frame +// completes or the destination fills up. +static inline int sfs_lz4_phase1(LZ4F_dctx *ctx, SfsLz4State *state) { + while (state->dst_rem > 0) { + size_t src_chunk = state->src_rem; + size_t dst_chunk = state->dst_rem; + size_t hint = LZ4F_decompress(ctx, state->dstp, &dst_chunk, state->srcp, + &src_chunk, NULL); + + if (LZ4F_isError(hint)) { + return sfs_lz4_fail(ctx); + } + + state->srcp += src_chunk; + state->src_rem -= src_chunk; + state->dstp += dst_chunk; + state->dst_rem -= dst_chunk; + + if (hint == 0) { + if (state->dst_rem != 0) { + return sfs_lz4_fail(ctx); + } + return 0; + } + + if (src_chunk == 0 && dst_chunk == 0) { + return sfs_lz4_fail(ctx); + } + + if (state->src_rem == 0 && hint != 0 && state->dst_rem > 0) { + return sfs_lz4_fail(ctx); + } + } + + return 1; +} + +// Phase 2 drains frame trailer/checksum bytes after output is full. +static inline int sfs_lz4_phase2(LZ4F_dctx *ctx, SfsLz4State *state) { + unsigned char scratch[64]; + + for (;;) { + size_t src_chunk = state->src_rem; + size_t dst_chunk = sizeof(scratch); + size_t hint = LZ4F_decompress(ctx, scratch, &dst_chunk, state->srcp, + &src_chunk, NULL); + + if (LZ4F_isError(hint)) { + return sfs_lz4_fail(ctx); + } + + state->srcp += src_chunk; + state->src_rem -= src_chunk; + + if (dst_chunk != 0) { + return sfs_lz4_fail(ctx); + } + + if (hint == 0) { + return 0; + } + + if (src_chunk == 0) { + return sfs_lz4_fail(ctx); + } + } +} + +/* Shared SFS LZ4 frame decompression path used by runtime and tests. + * + * Decompresses an LZ4 frame at src[0..src_len) into dst[0..dst_len). + * dst_len must equal the exact uncompressed size. Returns 0 on success, + * -1 on error (errno set to EIO, ENOMEM, or EINVAL). + * + * Two common patterns for LZ4F_decompress completing the frame: + * + * (a) Everything in one call: hint=0, all src consumed, all dst written. + * (b) Dst fills before hint=0: output buffer exactly full, but the frame + * still has trailing bytes (end mark + optional content checksum). + * A scratch-buffer drain loop is needed to let LZ4F finish. + */ +static inline int sfs_lz4_decompress_frame(const unsigned char *src, + size_t src_len, + unsigned char *dst, + size_t dst_len) { + if (!src || !dst) { + errno = EINVAL; + return -1; + } + + LZ4F_dctx *ctx = NULL; + size_t cctx_res = LZ4F_createDecompressionContext(&ctx, LZ4F_VERSION); + if (LZ4F_isError(cctx_res) || !ctx) { + errno = ENOMEM; + return -1; + } + + SfsLz4State state = { + .srcp = src, + .src_rem = src_len, + .dstp = dst, + .dst_rem = dst_len, + }; + + int phase1 = sfs_lz4_phase1(ctx, &state); + if (phase1 < 0) { + return -1; + } + if (phase1 == 0) { + LZ4F_freeDecompressionContext(ctx); + return 0; + } + + if (sfs_lz4_phase2(ctx, &state) != 0) { + return -1; + } + + LZ4F_freeDecompressionContext(ctx); + return 0; +} + +#endif diff --git a/stubs/sfs_runtime.c b/stubs/sfs_runtime.c new file mode 100644 index 0000000..dd763fa --- /dev/null +++ b/stubs/sfs_runtime.c @@ -0,0 +1,312 @@ +#include "sfs_runtime.h" + +#if __has_include("zeroperl.h") +#include "zeroperl.h" +#else +struct sfs_entry { + const char *abspath; + const unsigned char *start; + const unsigned char *end; + uint32_t decompressed_size; + uint8_t codec; +}; +#endif + +#include +#include +#include + +static inline bool sfs_runtime_fd_is_in_use(const SfsRuntime *runtime, int fd) { + if (fd < 0 || fd >= FD_MAX_TRACK) { + return false; + } + return runtime->fd_in_use[fd]; +} + +static void sfs_runtime_sanitize_path(char *dst, size_t dstsize, + const char *src) { + size_t j = 0; + size_t limit = dstsize > 0 ? dstsize - 1 : 0; + for (size_t i = 0; src[i] != '\0' && j < limit; i++) { + if (i > 0 && src[i] == '/' && src[i - 1] == '/') { + continue; + } + dst[j++] = src[i]; + } + if (dstsize > 0) { + dst[j] = '\0'; + } +} + +static const struct sfs_entry *sfs_runtime_lookup_entry( + const SfsRuntime *runtime, const struct sfs_entry *entries, + size_t entry_count, const char *path) { + if (!sfs_runtime_has_prefix(runtime, path)) { + return NULL; + } + + size_t path_len = strlen(path); + char *sanitized = (char *)malloc(path_len + 1); + if (!sanitized) { + errno = ENOMEM; + return NULL; + } + sfs_runtime_sanitize_path(sanitized, path_len + 1, path); + + const struct sfs_entry *found = NULL; + for (size_t i = 0; i < entry_count; i++) { + if (strcmp(sanitized, entries[i].abspath) == 0) { + found = &entries[i]; + break; + } + } + free(sanitized); + return found; +} + +static SfsOpenFile *sfs_runtime_find_by_fd(SfsRuntime *runtime, int fd) { + for (int i = 0; i < SFS_MAX_OPEN_FILES; i++) { + if (runtime->table[i].used && runtime->table[i].fd == fd) { + return &runtime->table[i]; + } + } + return NULL; +} + +static int sfs_runtime_allocate_fd(SfsRuntime *runtime) { + for (int i = 0; i < SFS_MAX_OPEN_FILES * 2; i++) { + int fd = runtime->next_virtual_fd++; + if (fd < SFS_VIRTUAL_FD_BASE) { + runtime->next_virtual_fd = SFS_VIRTUAL_FD_BASE + 1; + fd = SFS_VIRTUAL_FD_BASE; + } + if (!sfs_runtime_find_by_fd(runtime, fd) && + !sfs_runtime_fd_is_in_use(runtime, fd)) { + sfs_runtime_mark_fd_in_use(runtime, fd); + return fd; + } + } + errno = EMFILE; + return -1; +} + +void sfs_runtime_init(SfsRuntime *runtime, const char *prefix) { + memset(runtime, 0, sizeof(*runtime)); + runtime->fd_start = SFS_VIRTUAL_FD_BASE; + runtime->next_virtual_fd = SFS_VIRTUAL_FD_BASE; + runtime->prefix = prefix; + sfs_cache_init(&runtime->cache); +} + +void sfs_runtime_dispose(SfsRuntime *runtime) { + for (int i = 0; i < SFS_MAX_OPEN_FILES; i++) { + if (runtime->table[i].used && runtime->table[i].fp) { + fclose(runtime->table[i].fp); + } + free(runtime->table[i].owned_data); + runtime->table[i] = (SfsOpenFile){ + .used = false, + .fd = 0, + .fp = NULL, + .size = 0, + .lru = NULL, + .owned_data = NULL, + }; + } + sfs_cache_dispose(&runtime->cache); +} + +void sfs_runtime_mark_fd_in_use(SfsRuntime *runtime, int fd) { + if (fd >= 0 && fd < FD_MAX_TRACK) { + runtime->fd_in_use[fd] = true; + } +} + +void sfs_runtime_mark_fd_free(SfsRuntime *runtime, int fd) { + if (fd >= 0 && fd < FD_MAX_TRACK) { + runtime->fd_in_use[fd] = false; + } +} + +bool sfs_runtime_has_prefix(const SfsRuntime *runtime, const char *path) { + size_t len = strlen(runtime->prefix); + if (strncmp(path, runtime->prefix, len) == 0) { + return true; + } + return false; +} + +int sfs_runtime_open(SfsRuntime *runtime, const struct sfs_entry *entries, + size_t entry_count, const char *path, FILE **outfp) { + errno = 0; + const struct sfs_entry *entry = + sfs_runtime_lookup_entry(runtime, entries, entry_count, path); + if (!entry) { + if (errno == 0) { + errno = ENOENT; + } + if (outfp) { + *outfp = NULL; + } + return -1; + } + + const unsigned char *data_start = NULL; + size_t data_size = 0; + SfsLruEntry *lru = NULL; + unsigned char *owned_data = NULL; + if (sfs_entry_materialize(&runtime->cache, entry, &data_start, &data_size, + &lru, &owned_data) != 0) { + if (outfp) { + *outfp = NULL; + } + return -1; + } + + FILE *fp = fmemopen((void *)data_start, data_size, "rb"); + if (!fp) { + free(owned_data); + sfs_cache_release(lru); + if (outfp) { + *outfp = NULL; + } + return -1; + } + + for (int i = 0; i < SFS_MAX_OPEN_FILES; i++) { + if (!runtime->table[i].used) { + int fd = sfs_runtime_allocate_fd(runtime); + if (fd < 0) { + fclose(fp); + free(owned_data); + sfs_cache_release(lru); + if (outfp) { + *outfp = NULL; + } + return -1; + } + runtime->table[i] = (SfsOpenFile){ + .used = true, + .fd = fd, + .fp = fp, + .size = data_size, + .lru = lru, + .owned_data = owned_data, + }; + if (outfp) { + *outfp = fp; + } + return fd; + } + } + + fclose(fp); + free(owned_data); + sfs_cache_release(lru); + errno = EMFILE; + if (outfp) { + *outfp = NULL; + } + return -1; +} + +SFS_Result sfs_runtime_close(SfsRuntime *runtime, int fd) { + SfsOpenFile *entry = sfs_runtime_find_by_fd(runtime, fd); + if (!entry) { + return SFS_NOT_OURS; + } + if (!entry->fp) { + return SFS_ERR; + } + + fclose(entry->fp); + entry->fp = NULL; + free(entry->owned_data); + entry->owned_data = NULL; + sfs_cache_release(entry->lru); + entry->lru = NULL; + sfs_runtime_mark_fd_free(runtime, entry->fd); + entry->used = false; + entry->fd = -1; + entry->size = 0; + return SFS_OK; +} + +ssize_t sfs_runtime_read(SfsRuntime *runtime, int fd, void *buf, size_t count) { + SfsOpenFile *entry = sfs_runtime_find_by_fd(runtime, fd); + if (!entry || !entry->fp) { + return -1; + } + return (ssize_t)fread(buf, 1, count, entry->fp); +} + +// NOLINTNEXTLINE(bugprone-easily-swappable-parameters): mirrors POSIX lseek signature. +off_t sfs_runtime_lseek(SfsRuntime *runtime, int fd, off_t offset, + int whence) { + SfsOpenFile *entry = sfs_runtime_find_by_fd(runtime, fd); + if (!entry || !entry->fp) { + return (off_t)-1; + } + if (fseek(entry->fp, (long)offset, whence) != 0) { + return (off_t)-1; + } + long pos = ftell(entry->fp); + return pos < 0 ? (off_t)-1 : (off_t)pos; +} + +int sfs_runtime_access(SfsRuntime *runtime, const struct sfs_entry *entries, + size_t entry_count, const char *path) { + errno = 0; + const struct sfs_entry *entry = + sfs_runtime_lookup_entry(runtime, entries, entry_count, path); + if (!entry) { + if (errno == 0) { + errno = ENOENT; + } + return -1; + } + (void)entry; + return 0; +} + +SFS_Stat_Result sfs_runtime_stat(SfsRuntime *runtime, + const struct sfs_entry *entries, + size_t entry_count, const char *path, int fd, + struct stat *stbuf) { + if (path) { + if (!sfs_runtime_has_prefix(runtime, path)) { + return SFS_STAT_NOT_OURS; + } + errno = 0; + const struct sfs_entry *entry = + sfs_runtime_lookup_entry(runtime, entries, entry_count, path); + if (!entry) { + if (errno == 0) { + errno = ENOENT; + } + return SFS_STAT_ERR; + } + memset(stbuf, 0, sizeof(*stbuf)); + stbuf->st_size = (off_t)sfs_entry_effective_size(entry); + stbuf->st_mode = S_IFREG; + return SFS_STAT_OURS; + } + + SfsOpenFile *entry = sfs_runtime_find_by_fd(runtime, fd); + if (!entry) { + return SFS_STAT_NOT_OURS; + } + memset(stbuf, 0, sizeof(*stbuf)); + stbuf->st_size = (off_t)entry->size; + stbuf->st_mode = S_IFREG; + return SFS_STAT_OURS; +} + +int sfs_runtime_fileno(SfsRuntime *runtime, FILE *stream) { + for (int i = 0; i < SFS_MAX_OPEN_FILES; i++) { + if (runtime->table[i].used && runtime->table[i].fp == stream) { + return runtime->table[i].fd; + } + } + return -1; +} \ No newline at end of file diff --git a/stubs/sfs_runtime.h b/stubs/sfs_runtime.h new file mode 100644 index 0000000..f564e4f --- /dev/null +++ b/stubs/sfs_runtime.h @@ -0,0 +1,74 @@ +#ifndef ZEROPERL_SFS_RUNTIME_H +#define ZEROPERL_SFS_RUNTIME_H + +#include "sfs_compression.h" + +#include +#include +#include +#include +#include + +#ifndef FD_MAX_TRACK +#define FD_MAX_TRACK 32 +#endif + +#ifndef SFS_MAX_OPEN_FILES +#define SFS_MAX_OPEN_FILES 16 +#endif + +#ifndef SFS_VIRTUAL_FD_BASE +#define SFS_VIRTUAL_FD_BASE 1024 +#endif + +struct sfs_entry; + +typedef struct { + bool used; + int fd; + FILE *fp; + size_t size; + SfsLruEntry *lru; + unsigned char *owned_data; +} SfsOpenFile; + +typedef struct { + bool fd_in_use[FD_MAX_TRACK]; + SfsOpenFile table[SFS_MAX_OPEN_FILES]; + int fd_start; + int next_virtual_fd; + const char *prefix; + SfsCache cache; +} SfsRuntime; + +typedef enum { SFS_OK = 0, SFS_ERR = -1, SFS_NOT_OURS = -2 } SFS_Result; + +typedef enum { + SFS_STAT_ERR = -1, + SFS_STAT_OURS = 0, + SFS_STAT_NOT_OURS = 1 +} SFS_Stat_Result; + +void sfs_runtime_init(SfsRuntime *runtime, const char *prefix); +void sfs_runtime_dispose(SfsRuntime *runtime); + +void sfs_runtime_mark_fd_in_use(SfsRuntime *runtime, int fd); +void sfs_runtime_mark_fd_free(SfsRuntime *runtime, int fd); +bool sfs_runtime_has_prefix(const SfsRuntime *runtime, const char *path); + +int sfs_runtime_open(SfsRuntime *runtime, const struct sfs_entry *entries, + size_t entry_count, const char *path, FILE **outfp); +SFS_Result sfs_runtime_close(SfsRuntime *runtime, int fd); +ssize_t sfs_runtime_read(SfsRuntime *runtime, int fd, void *buf, size_t count); +// NOLINTNEXTLINE(bugprone-easily-swappable-parameters): mirrors POSIX lseek signature. +off_t sfs_runtime_lseek(SfsRuntime *runtime, int fd, off_t offset, + int whence); +int sfs_runtime_access(SfsRuntime *runtime, const struct sfs_entry *entries, + size_t entry_count, const char *path); +SFS_Stat_Result sfs_runtime_stat(SfsRuntime *runtime, + const struct sfs_entry *entries, + size_t entry_count, const char *path, int fd, + struct stat *stbuf); +int sfs_runtime_fileno(SfsRuntime *runtime, FILE *stream); + +#endif \ No newline at end of file diff --git a/stubs/stubs.c b/stubs/stubs.c index 6ea542c..c920e5e 100644 --- a/stubs/stubs.c +++ b/stubs/stubs.c @@ -1,5 +1,7 @@ #include #include +#include +#include // Define mode_t as unsigned int if not already defined typedef unsigned int mode_t; @@ -36,8 +38,12 @@ int do_aspawn(int arg1, int arg2, int arg3) { return -1; } // Adjusted signature int do_spawn(int arg1) { return -1; } // Adjusted signature // Pipe and wait +int pipe(int fds[2]) { errno = ENOSYS; return -1; } int PerlProc_pipe_cloexec(int fds[2]) { return -1; } int wait(int *status) { return -1; } +// Temp file +FILE *tmpfile(void) { errno = ENOTSUP; return NULL; } + // Timezone functions int tzset() { return 0; } // Adjusted to return int as expected diff --git a/stubs/stubs.h b/stubs/stubs.h index 5bbb419..77c7388 100644 --- a/stubs/stubs.h +++ b/stubs/stubs.h @@ -2,6 +2,7 @@ #define STUBS_H #include +#include // Inline stub implementations for missing system calls @@ -19,6 +20,12 @@ static inline int kill(pid_t pid, int sig) { return 0; } // File descriptor duplication static inline int dup(int oldfd) { return -1; } +// Pipe (not available on WASI) +static inline int pipe(int fds[2]) { errno = ENOSYS; return -1; } + +// Temp file (not available on WASI) +static inline FILE *tmpfile(void) { errno = ENOTSUP; return NULL; } + // File mode creation mask static inline mode_t umask(mode_t mask) { return 0; } diff --git a/stubs/zeroperl.c b/stubs/zeroperl.c index c32bf47..daa0e04 100644 --- a/stubs/zeroperl.c +++ b/stubs/zeroperl.c @@ -18,10 +18,17 @@ #include #include +// Compatibility: av_top_index was added in 5.18, older Perl uses av_len +#ifndef av_top_index +#define av_top_index(av) av_len(av) +#endif + #define STRINGIZE_HELPER(x) #x #define STRINGIZE(x) STRINGIZE_HELPER(x) #include +#include "sfs_runtime.h" + //! Export macro for public API functions - combines export_name for WASI with //! visibility attribute #if defined(__WASI__) || defined(__wasi__) @@ -68,6 +75,15 @@ static char zero_perl_error_buf[1024] = {0}; //! Host error message buffer (stores last host error) static char host_error_buf[1024] = {0}; +#define ZEROPERL_EMBEDDED_LIB_PREFIX \ + "/zeroperl/lib/" STRINGIZE(PERL_REVISION) "." STRINGIZE(PERL_VERSION) "." \ + STRINGIZE(PERL_SUBVERSION) +#define ZEROPERL_EMBEDDED_ARCH_LIB ZEROPERL_EMBEDDED_LIB_PREFIX "/wasm32-wasi" + +#ifndef ZEROPERL_PERL5LIB_MAX +#define ZEROPERL_PERL5LIB_MAX 4096 +#endif + //! Environment variables extern char **environ; @@ -84,277 +100,42 @@ extern int __real_stat(const char *restrict path, struct stat *restrict statbuf); extern int __real_fstat(int fd, struct stat *statbuf); -//! Maximum number of file descriptors to track -#ifndef FD_MAX_TRACK -#define FD_MAX_TRACK 32 -#endif - -//! Maximum number of open SFS (Simple File System) files -#ifndef SFS_MAX_OPEN_FILES -#define SFS_MAX_OPEN_FILES 16 -#endif - -//! Tracks which file descriptors are in use -static bool g_fd_in_use[FD_MAX_TRACK] = {false}; - -//! Marks a file descriptor as in use (not thread-safe) -static inline void fd_mark_in_use(int fd) { - if (fd >= 0 && fd < FD_MAX_TRACK) { - g_fd_in_use[fd] = true; - } -} - -//! Marks a file descriptor as free -static inline void fd_mark_free(int fd) { - if (fd >= 0 && fd < FD_MAX_TRACK) { - g_fd_in_use[fd] = false; - } -} - -//! Checks if a file descriptor is in use -//! Out-of-range FDs are treated as in use -static inline bool fd_is_in_use(int fd) { - return (fd >= 0 && fd < FD_MAX_TRACK) ? g_fd_in_use[fd] : true; -} - -//! SFS entry structure for tracking open virtual files -//! Each slot tracks an integer FD, a FILE* (via fmemopen), file size, and a -//! "used" flag -typedef struct { - bool used; - int fd; - FILE *fp; - size_t size; -} SFS_Entry; - -//! Table of open SFS files -static SFS_Entry sfs_table[SFS_MAX_OPEN_FILES]; - -//! Starting FD offset for SFS (skips standard FDs 0-2) -static int sfs_fd_start = 3; - -//! Result codes for SFS operations -typedef enum { SFS_OK = 0, SFS_ERR = -1, SFS_NOT_OURS = -2 } SFS_Result; - -//! Result codes for stat calls -typedef enum { - SFS_STAT_ERR = -1, // SFS path but not found/error - SFS_STAT_OURS = 0, // We handled it - SFS_STAT_NOT_OURS = 1 // Not an SFS path, use fallback -} SFS_Stat_Result; - -//! Removes consecutive duplicate '/' from a path for canonicalization -static void sfs_sanitize_path(char *dst, size_t dstsize, const char *src) { - size_t j = 0, limit = (dstsize > 0) ? (dstsize - 1) : 0; - for (size_t i = 0; src[i] != '\0' && j < limit; i++) { - if (i > 0 && src[i] == '/' && src[i - 1] == '/') { - continue; - } - dst[j++] = src[i]; - } - if (dstsize > 0) { - dst[j] = '\0'; - } -} - -//! Checks if a path begins with SFS_BUILTIN_PREFIX -static inline bool sfs_has_prefix(const char *path) { - size_t len = strlen(SFS_BUILTIN_PREFIX); - return (strncmp(path, SFS_BUILTIN_PREFIX, len) == 0); -} - -//! Looks up a path in the SFS and returns its data if found -//! Path is always sanitized before comparison -static bool sfs_lookup_path(const char *path, const unsigned char **found_start, - size_t *found_size) { - if (!sfs_has_prefix(path)) { - return false; - } - - char sanitized[256]; - sfs_sanitize_path(sanitized, sizeof(sanitized), path); - - for (size_t i = 0; i < sfs_builtin_files_num; i++) { - if (strcmp(sanitized, sfs_entries[i].abspath) == 0) { - *found_start = sfs_entries[i].start; - *found_size = (size_t)(sfs_entries[i].end - sfs_entries[i].start); - return true; - } - } - return false; -} - -//! Finds the next free descriptor in [sfs_fd_start..FD_MAX_TRACK-1] -//! Forcibly exits if no free FDs are available -static int sfs_allocate_fd(void) { - for (int fd = sfs_fd_start; fd < FD_MAX_TRACK; fd++) { - if (!fd_is_in_use(fd)) { - fd_mark_in_use(fd); - return fd; - } - } - __wasi_proc_exit(10); - return -1; -} - -//! Finds an SFS table entry by file descriptor -static SFS_Entry *sfs_find_by_fd(int fd) { - for (int i = 0; i < SFS_MAX_OPEN_FILES; i++) { - if (sfs_table[i].used && sfs_table[i].fd == fd) { - return &sfs_table[i]; - } - } - return NULL; -} - -//! Opens a path from SFS using fmemopen and allocates an FD -static int sfs_open(const char *path, FILE **outfp) { - const unsigned char *start = NULL; - size_t size = 0; - - if (!sfs_lookup_path(path, &start, &size)) { - errno = ENOENT; - if (outfp) - *outfp = NULL; - return -1; - } - - FILE *fp = fmemopen((void *)start, size, "rb"); - if (!fp) { - if (outfp) - *outfp = NULL; - return -1; - } - - for (int i = 0; i < SFS_MAX_OPEN_FILES; i++) { - if (!sfs_table[i].used) { - int newfd = sfs_allocate_fd(); - sfs_table[i].used = true; - sfs_table[i].fd = newfd; - sfs_table[i].fp = fp; - sfs_table[i].size = size; - if (outfp) - *outfp = fp; - return newfd; - } - } - - fclose(fp); - errno = EMFILE; - if (outfp) - *outfp = NULL; - return -1; -} +static SfsRuntime sfs_runtime; +static bool sfs_runtime_initialized = false; -//! Closes an SFS file descriptor and frees its slot -static SFS_Result sfs_close(int fd) { - SFS_Entry *e = sfs_find_by_fd(fd); - if (!e) { - return SFS_NOT_OURS; - } - if (!e->fp) { - return SFS_ERR; +static inline void sfs_runtime_ensure_initialized(void) { + if (!sfs_runtime_initialized) { + sfs_runtime_init(&sfs_runtime, SFS_BUILTIN_PREFIX); + sfs_runtime_initialized = true; } - - fclose(e->fp); - e->fp = NULL; - fd_mark_free(e->fd); - e->used = false; - e->fd = -1; - e->size = 0; - return SFS_OK; } -//! Reads from in-memory data if FD is ours, returns -1 if not -__attribute__((noinline)) static ssize_t sfs_read(int fd, void *buf, - size_t count) { - SFS_Entry *e = sfs_find_by_fd(fd); - if (!e || !e->fp) { - return -1; - } - return (ssize_t)fread(buf, 1, count, e->fp); -} - -//! Performs fseek/ftell if FD is ours -static off_t sfs_lseek(int fd, off_t offset, int whence) { - SFS_Entry *e = sfs_find_by_fd(fd); - if (!e || !e->fp) { - return (off_t)-1; - } - if (fseek(e->fp, (long)offset, whence) != 0) { - return (off_t)-1; - } - long pos = ftell(e->fp); - if (pos < 0) { - return (off_t)-1; - } - return (off_t)pos; -} - -//! Checks if a path exists in SFS - no fallback if path has our prefix -static int sfs_access(const char *path) { - const unsigned char *start = NULL; - size_t size = 0; - if (sfs_lookup_path(path, &start, &size)) { - return 0; - } - errno = ENOENT; - return -1; -} - -//! Path-based or FD-based stat operation -//! If path != NULL: path-based. If path == NULL: FD-based -static SFS_Stat_Result sfs_stat(const char *path, int fd, struct stat *stbuf) { - if (path) { - if (sfs_has_prefix(path)) { - const unsigned char *start = NULL; - size_t size = 0; - if (!sfs_lookup_path(path, &start, &size)) { - errno = ENOENT; - return SFS_STAT_ERR; - } - memset(stbuf, 0, sizeof(*stbuf)); - stbuf->st_size = (off_t)size; - stbuf->st_mode = S_IFREG; - return SFS_STAT_OURS; - } - return SFS_STAT_NOT_OURS; - } else { - SFS_Entry *e = sfs_find_by_fd(fd); - if (!e) { - return SFS_STAT_NOT_OURS; - } - memset(stbuf, 0, sizeof(*stbuf)); - stbuf->st_size = (off_t)e->size; - stbuf->st_mode = S_IFREG; - return SFS_STAT_OURS; - } -} //! Wrapper for fopen: tries SFS first, then falls back to real fopen __attribute__((noinline)) FILE *__wrap_fopen(const char *path, const char *mode) { - if (sfs_has_prefix(path)) { + sfs_runtime_ensure_initialized(); + if (sfs_runtime_has_prefix(&sfs_runtime, path)) { FILE *fp = NULL; - int sfd = sfs_open(path, &fp); + int sfd = sfs_runtime_open(&sfs_runtime, sfs_entries, sfs_builtin_files_num, + path, &fp); if (sfd >= 0) { return fp; } - return NULL; + /* SFS doesn't have this file; fall through to real filesystem. */ } FILE *realfp = __real_fopen(path, mode); if (realfp) { int realfd = fileno(realfp); - if (realfd >= 0 && realfd < FD_MAX_TRACK) { - fd_mark_in_use(realfd); - } + sfs_runtime_mark_fd_in_use(&sfs_runtime, realfd); } return realfp; } //! Wrapper for open: tries SFS first, then falls back to real open __attribute__((noinline)) int __wrap_open(const char *path, int flags, ...) { + sfs_runtime_ensure_initialized(); va_list args; va_start(args, flags); int mode = 0; @@ -363,31 +144,29 @@ __attribute__((noinline)) int __wrap_open(const char *path, int flags, ...) { } va_end(args); - if (sfs_has_prefix(path)) { - int sfd = sfs_open(path, NULL); + if (sfs_runtime_has_prefix(&sfs_runtime, path)) { + int sfd = sfs_runtime_open(&sfs_runtime, sfs_entries, sfs_builtin_files_num, + path, NULL); if (sfd >= 0) { return sfd; } - return -1; + /* SFS doesn't have this file; fall through to real filesystem. */ } int realfd = __real_open(path, flags, mode); - if (realfd >= 0 && realfd < FD_MAX_TRACK) { - fd_mark_in_use(realfd); - } + sfs_runtime_mark_fd_in_use(&sfs_runtime, realfd); return realfd; } //! Wrapper for close: tries SFS first, then falls back to real close __attribute__((noinline)) int __wrap_close(int fd) { - SFS_Result rc = sfs_close(fd); + sfs_runtime_ensure_initialized(); + SFS_Result rc = sfs_runtime_close(&sfs_runtime, fd); if (rc == SFS_OK) { return 0; } if (rc == SFS_NOT_OURS) { - if (fd >= 0 && fd < FD_MAX_TRACK) { - fd_mark_free(fd); - } + sfs_runtime_mark_fd_free(&sfs_runtime, fd); return __real_close(fd); } return (int)rc; @@ -395,8 +174,14 @@ __attribute__((noinline)) int __wrap_close(int fd) { //! Wrapper for access: tries SFS first, then falls back to real access __attribute__((noinline)) int __wrap_access(const char *path, int amode) { - if (sfs_has_prefix(path)) { - return sfs_access(path); + sfs_runtime_ensure_initialized(); + if (sfs_runtime_has_prefix(&sfs_runtime, path)) { + int rc = sfs_runtime_access(&sfs_runtime, sfs_entries, sfs_builtin_files_num, + path); + if (rc == 0) { + return 0; + } + /* SFS doesn't have this path; fall through to real filesystem. */ } return __real_access(path, amode); } @@ -404,31 +189,32 @@ __attribute__((noinline)) int __wrap_access(const char *path, int amode) { //! Wrapper for stat: tries SFS first, then falls back to real stat __attribute__((noinline)) int __wrap_stat(const char *restrict path, struct stat *restrict stbuf) { - SFS_Stat_Result rc = sfs_stat(path, -1, stbuf); + sfs_runtime_ensure_initialized(); + SFS_Stat_Result rc = sfs_runtime_stat(&sfs_runtime, sfs_entries, + sfs_builtin_files_num, path, -1, stbuf); if (rc == SFS_STAT_OURS) { return 0; } - if (rc == SFS_STAT_ERR) { - return -1; - } + /* SFS_STAT_ERR: path has SFS prefix but file not in SFS; fall through. */ return __real_stat(path, stbuf); } //! Wrapper for fstat: tries SFS first, then falls back to real fstat __attribute__((noinline)) int __wrap_fstat(int fd, struct stat *stbuf) { - SFS_Stat_Result rc = sfs_stat(NULL, fd, stbuf); + sfs_runtime_ensure_initialized(); + SFS_Stat_Result rc = sfs_runtime_stat(&sfs_runtime, sfs_entries, + sfs_builtin_files_num, NULL, fd, stbuf); if (rc == SFS_STAT_OURS) { return 0; } - if (rc == SFS_STAT_ERR) { - return -1; - } + /* SFS_STAT_ERR or SFS_STAT_NOT_OURS: fall through to real fstat. */ return __real_fstat(fd, stbuf); } //! Wrapper for read: tries SFS first, then falls back to real read __attribute__((noinline)) ssize_t __wrap_read(int fd, void *buf, size_t count) { - ssize_t r = sfs_read(fd, buf, count); + sfs_runtime_ensure_initialized(); + ssize_t r = sfs_runtime_read(&sfs_runtime, fd, buf, count); if (r >= 0) { return r; } @@ -437,7 +223,8 @@ __attribute__((noinline)) ssize_t __wrap_read(int fd, void *buf, size_t count) { //! Wrapper for lseek: tries SFS first, then falls back to real lseek __attribute__((noinline)) off_t __wrap_lseek(int fd, off_t offset, int whence) { - off_t pos = sfs_lseek(fd, offset, whence); + sfs_runtime_ensure_initialized(); + off_t pos = sfs_runtime_lseek(&sfs_runtime, fd, offset, whence); if (pos >= 0) { return pos; } @@ -446,16 +233,14 @@ __attribute__((noinline)) off_t __wrap_lseek(int fd, off_t offset, int whence) { //! Wrapper for fileno: checks SFS first, then falls back to real fileno __attribute__((noinline)) int __wrap_fileno(FILE *stream) { - for (int i = 0; i < SFS_MAX_OPEN_FILES; i++) { - if (sfs_table[i].used && sfs_table[i].fp == stream) { - return sfs_table[i].fd; - } + sfs_runtime_ensure_initialized(); + int sfsfd = sfs_runtime_fileno(&sfs_runtime, stream); + if (sfsfd >= 0) { + return sfsfd; } int realfd = __real_fileno(stream); - if (realfd >= 0 && realfd < FD_MAX_TRACK) { - fd_mark_in_use(realfd); - } + sfs_runtime_mark_fd_in_use(&sfs_runtime, realfd); return realfd; } @@ -613,6 +398,102 @@ const char *zeroperl_get_host_error(void) { return host_error_buf; } ZEROPERL_API("zeroperl_clear_host_error") void zeroperl_clear_host_error(void) { host_error_buf[0] = '\0'; } +static bool zeroperl_env_list_contains_path(const char *list, const char *path) { + if (!list || !path || path[0] == '\0') { + return false; + } + + size_t path_len = strlen(path); + const char *segment = list; + while (*segment != '\0') { + const char *end = strchr(segment, ':'); + size_t len = end ? (size_t)(end - segment) : strlen(segment); + if (len == path_len && strncmp(segment, path, path_len) == 0) { + return true; + } + if (!end) { + break; + } + segment = end + 1; + } + + return false; +} + +static int zeroperl_append_env_segment(char *dst, size_t dst_size, size_t *used, + const char *segment) { + if (!segment || segment[0] == '\0') { + return 0; + } + + size_t segment_len = strlen(segment); + size_t required = *used + segment_len + 1; + if (*used > 0) { + required++; + } + if (required > dst_size) { + errno = ENAMETOOLONG; + return -1; + } + + if (*used > 0) { + dst[*used] = ':'; + (*used)++; + } + memcpy(dst + *used, segment, segment_len + 1); + *used += segment_len; + return 0; +} + +static int zeroperl_prepare_embedded_perl5lib(void) { + const char *existing = getenv("PERL5LIB"); + bool has_arch = zeroperl_env_list_contains_path(existing, + ZEROPERL_EMBEDDED_ARCH_LIB); + bool has_lib = zeroperl_env_list_contains_path(existing, + ZEROPERL_EMBEDDED_LIB_PREFIX); + if (has_arch && has_lib) { + return 0; + } + + char combined[ZEROPERL_PERL5LIB_MAX]; + size_t used = 0; + combined[0] = '\0'; + + // Native Perl precedence: existing PERL5LIB comes first, followed by the + // embedded arch/lib paths. This ensures user-supplied directories are + // searched before the bundled libraries. + if (existing && existing[0] != '\0' && + zeroperl_append_env_segment(combined, sizeof(combined), &used, existing) != + 0) { + snprintf(zero_perl_error_buf, sizeof(zero_perl_error_buf), + "combined PERL5LIB exceeds %d bytes", ZEROPERL_PERL5LIB_MAX); + return -1; + } + if (!has_arch && + zeroperl_append_env_segment(combined, sizeof(combined), &used, + ZEROPERL_EMBEDDED_ARCH_LIB) != 0) { + snprintf(zero_perl_error_buf, sizeof(zero_perl_error_buf), + "embedded PERL5LIB entry too long: %s", ZEROPERL_EMBEDDED_ARCH_LIB); + return -1; + } + if (!has_lib && + zeroperl_append_env_segment(combined, sizeof(combined), &used, + ZEROPERL_EMBEDDED_LIB_PREFIX) != 0) { + snprintf(zero_perl_error_buf, sizeof(zero_perl_error_buf), + "embedded PERL5LIB entry too long: %s", + ZEROPERL_EMBEDDED_LIB_PREFIX); + return -1; + } + + if (setenv("PERL5LIB", combined, 1) != 0) { + snprintf(zero_perl_error_buf, sizeof(zero_perl_error_buf), + "failed to set PERL5LIB: %s", strerror(errno)); + return -1; + } + + return 0; +} + //! XS callback that dispatches to host functions static XS(xs_host_dispatch) { dXSARGS; @@ -666,9 +547,16 @@ static int zeroperl_init_callback(int argc, char **argv) { (void)argc; zeroperl_context *ctx = (zeroperl_context *)argv; + if (zeroperl_prepare_embedded_perl5lib() != 0) { + ctx->result = 1; + return 1; + } + if (!zero_perl_system_initialized) { PERL_SYS_INIT3(&ctx->data.init.argc, &ctx->data.init.argv, &environ); +#ifdef PERL_SYS_FPU_INIT PERL_SYS_FPU_INIT; +#endif zero_perl_system_initialized = true; } @@ -893,6 +781,11 @@ static int zeroperl_reset_callback(int argc, char **argv) { return -1; } + if (zeroperl_prepare_embedded_perl5lib() != 0) { + ctx->result = 1; + return 1; + } + perl_destruct(zero_perl); perl_construct(zero_perl); @@ -2205,6 +2098,9 @@ void zeroperl_result_free(zeroperl_result *result) { free(result); } +#ifdef ZEROPERL_USE_GENERATED_XS_INIT +#include "xs_init.inc" +#else EXTERN_C void boot_DynaLoader(pTHX_ CV *cv); EXTERN_C void boot_File__Glob(pTHX_ CV *cv); EXTERN_C void boot_Sys__Hostname(pTHX_ CV *cv); @@ -2285,4 +2181,5 @@ static void xs_init(pTHX) { newXS("Fcntl::bootstrap", boot_Fcntl, file); newXS("Opcode::bootstrap", boot_Opcode, file); newXS("Time::HiRes::bootstrap", boot_Time__HiRes, file); -} \ No newline at end of file +} +#endif diff --git a/tests/sfs/Makefile b/tests/sfs/Makefile new file mode 100644 index 0000000..863afc4 --- /dev/null +++ b/tests/sfs/Makefile @@ -0,0 +1,44 @@ +# tests/sfs/Makefile +# Build and run SFS baseline tests natively on macOS/Linux. +# +# Usage: +# make # build + run both test suites +# make test-sfs # compile + run C harness only +# make test-gen # run Node.js generator tests only +# make clean # remove build artifacts + +CC ?= cc +CFLAGS ?= -std=c11 -D_DEFAULT_SOURCE -Wall -Wextra -O0 -g +TEST_DEFS ?= -DSFS_LRU_MAX=8 -DSFS_LRU_CAP_BYTES=256 +# Cross-platform LZ4 detection: pkg-config (Linux/Debian) first, then Homebrew (macOS) +LZ4_CFLAGS := $(shell pkg-config --cflags liblz4 2>/dev/null) +LZ4_LIBS := $(shell pkg-config --libs liblz4 2>/dev/null) +ifeq ($(LZ4_CFLAGS),) + LZ4_PREFIX := $(shell brew --prefix lz4 2>/dev/null || echo /usr/local) + LZ4_CFLAGS := -I$(LZ4_PREFIX)/include + LZ4_LIBS := -L$(LZ4_PREFIX)/lib -llz4 +endif +CFLAGS += $(TEST_DEFS) +CFLAGS += $(LZ4_CFLAGS) +CFLAGS += -I../../stubs +CFLAGS += -I../../gen +LDFLAGS ?= $(LZ4_LIBS) +BINARY = /tmp/test-sfs-zeroperl + +.PHONY: all test-sfs test-gen clean + +all: test-sfs test-gen + +test-sfs: $(BINARY) + @echo "=== Running test-sfs.c ===" + $(BINARY) + +$(BINARY): test-sfs.c ../../stubs/sfs_runtime.c ../../stubs/sfs_runtime.h ../../stubs/sfs_compression.c ../../stubs/sfs_compression.h ../../stubs/sfs_lz4.h + $(CC) $(CFLAGS) -o $@ test-sfs.c ../../stubs/sfs_runtime.c ../../stubs/sfs_compression.c $(LDFLAGS) + +test-gen: + @echo "=== Running test-generator.js ===" + node test-generator.js + +clean: + rm -f $(BINARY) diff --git a/tests/sfs/test-generator.js b/tests/sfs/test-generator.js new file mode 100644 index 0000000..a43d6b2 --- /dev/null +++ b/tests/sfs/test-generator.js @@ -0,0 +1,532 @@ +#!/usr/bin/env node +// tests/sfs/test-generator.js +// Unit-style tests for tools/sfs.js output generation only. +// Limitation: these tests do not execute stubs/zeroperl.c runtime decode path; +// runtime behavior must be validated separately in integration tests. +// +// Run: node tests/sfs/test-generator.js +"use strict"; + +const assert = require("node:assert/strict"); +const fs = require("node:fs"); +const os = require("node:os"); +const path = require("node:path"); +const { execFileSync } = require("node:child_process"); +const lz4 = require(path.join(__dirname, "../../tools/node_modules/lz4")); + +const ROOT = path.resolve(__dirname, "../.."); +const SFS_JS = path.join(ROOT, "tools", "sfs.js"); + +let passed = 0; +let failed = 0; + +function test(name, fn) { + try { + fn(); + console.log(` PASS: ${name}`); + passed++; + } catch (e) { + console.error(` FAIL: ${name}`); + console.error(` ${e.message}`); + failed++; + } +} + +// --------------------------------------------------------------------------- +// Helpers +// --------------------------------------------------------------------------- + +function makeTmpDir() { + return fs.mkdtempSync(path.join(os.tmpdir(), "sfs-gen-test-")); +} + +function makeTmpHeader() { + return path.join(os.tmpdir(), `sfs-gen-test-${process.pid}-${Date.now()}.h`); +} + +function derivedPaths(headerPath) { + const base = headerPath.replace(/\.h$/, ""); + return { + header: headerPath, + dataC: base + "_data.c", + dataBin: base + "_data.bin", + }; +} + +function runSfs(inputDir, outputHeader, extraArgs = []) { + execFileSync( + "node", + [SFS_JS, "-i", inputDir, "-o", outputHeader, ...extraArgs], + { stdio: "pipe" }, + ); +} + +function runSfsWithEnv( + inputDir, + outputHeader, + extraArgs = [], + env = process.env, +) { + execFileSync( + process.execPath, + [SFS_JS, "-i", inputDir, "-o", outputHeader, ...extraArgs], + { stdio: "pipe", env }, + ); +} + +function nodeOnlyEnv() { + return { + ...process.env, + PATH: path.dirname(process.execPath), + }; +} + +function cleanup(outHeader, dir) { + const { dataC, dataBin } = derivedPaths(outHeader); + for (const f of [outHeader, dataC, dataBin]) { + // Best-effort cleanup for idempotent tests; ignore already-removed files. + try { + fs.unlinkSync(f); + } catch (error) { + void error; + } + } + // Remove temporary corpus directory recursively when provided. + if (dir) + try { + fs.rmSync(dir, { recursive: true }); + } catch (error) { + void error; + } +} + +/** + * Creates a deterministic test corpus: + * /lib/5.42.2/Carp.pm + * /lib/5.42.2/strict.pm + * /lib/site_perl/5.42.2/Image/ExifTool.pm + * /run.pl + * + * Returns an object with: + * - files: sorted relative paths (as sfs.js would emit them) + * - contents: map of relpath -> Buffer + */ +function makeTestCorpus(dir) { + const files = { + "lib/5.42.2/Carp.pm": Buffer.from("package Carp; 1;\n"), + "lib/5.42.2/strict.pm": Buffer.from("package strict; 1;\n"), + "lib/site_perl/5.42.2/Image/ExifTool.pm": Buffer.from( + "package Image::ExifTool; 1;\n", + ), + "run.pl": Buffer.from("#!/usr/bin/perl\n"), + }; + for (const [rel, data] of Object.entries(files)) { + const full = path.join(dir, rel); + fs.mkdirSync(path.dirname(full), { recursive: true }); + fs.writeFileSync(full, data); + } + const sorted = Object.keys(files).sort(); + return { files: sorted, contents: files }; +} + +// --------------------------------------------------------------------------- +// Tests +// --------------------------------------------------------------------------- + +console.log("\ntests/sfs/test-generator.js"); +console.log("====================================="); + +test("produces all three output files", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + makeTestCorpus(dir); + runSfs(dir, out); + const { dataC, dataBin } = derivedPaths(out); + assert.ok(fs.existsSync(out), "header file missing"); + assert.ok(fs.existsSync(dataC), "data.c file missing"); + assert.ok(fs.existsSync(dataBin), "data.bin file missing"); + } finally { + cleanup(out, dir); + } +}); + +test("traversal order is deterministic sorted", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + makeTestCorpus(dir); + runSfs(dir, out); + const src = fs.readFileSync(derivedPaths(out).dataC, "utf8"); + // Extract quoted path arguments from sfs_entries table rows + const quoted = [...src.matchAll(/"([^"]+)"/g)] + .map((m) => m[1]) + .filter((p) => !p.startsWith("#")); + // Filter to only abspaths (non-numeric and not header name) + const abspaths = quoted.filter((p) => p.startsWith("/") || p.includes("/")); + // They should be in sorted order + const sorted = [...abspaths].sort(); + assert.deepEqual(abspaths, sorted, "entries not in sorted order"); + } finally { + cleanup(out, dir); + } +}); + +test("entry count matches file count", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + const corpus = makeTestCorpus(dir); + runSfs(dir, out); + const src = fs.readFileSync(derivedPaths(out).dataC, "utf8"); + const m = src.match(/sfs_builtin_files_num\s*=\s*(\d+)/); + assert.ok(m, "sfs_builtin_files_num not found in data.c"); + assert.equal( + parseInt(m[1], 10), + corpus.files.length, + `expected ${corpus.files.length} entries`, + ); + } finally { + cleanup(out, dir); + } +}); + +test("prefix is prepended to all abspaths in header and data.c", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + makeTestCorpus(dir); + runSfs(dir, out, ["--prefix", "/zeroperl"]); + const hdr = fs.readFileSync(out, "utf8"); + const src = fs.readFileSync(derivedPaths(out).dataC, "utf8"); + assert.ok( + hdr.includes('SFS_BUILTIN_PREFIX "/zeroperl"'), + "SFS_BUILTIN_PREFIX not set in header", + ); + assert.ok(src.includes('"/zeroperl/'), "entries missing prefix in data.c"); + assert.ok(!src.includes('"lib/5.42.2'), "unprefixed path found in data.c"); + } finally { + cleanup(out, dir); + } +}); + +test("header declares sfs_entry struct and extern symbols", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + makeTestCorpus(dir); + runSfs(dir, out); + const hdr = fs.readFileSync(out, "utf8"); + assert.ok( + hdr.includes("struct sfs_entry"), + "struct sfs_entry missing from header", + ); + assert.ok( + hdr.includes("uint32_t decompressed_size"), + "decompressed_size field missing from struct sfs_entry", + ); + assert.ok( + hdr.includes("uint8_t codec"), + "codec field missing from struct sfs_entry", + ); + assert.ok( + hdr.includes("extern size_t sfs_builtin_files_num"), + "extern sfs_builtin_files_num missing", + ); + assert.ok( + hdr.includes("extern const struct sfs_entry sfs_entries[]"), + "extern sfs_entries[] missing", + ); + } finally { + cleanup(out, dir); + } +}); + +test("offset arithmetic: no gaps and no overlaps", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + makeTestCorpus(dir); + runSfs(dir, out); + const src = fs.readFileSync(derivedPaths(out).dataC, "utf8"); + const bin = fs.readFileSync(derivedPaths(out).dataBin); + // Parse pairs: sfs_builtin_data + START, sfs_builtin_data + START + LEN + // Each entry looks like: { "path", sfs_builtin_data + START, sfs_builtin_data + START + LEN } + const pairs = [ + ...src.matchAll( + /sfs_builtin_data \+ (\d+), sfs_builtin_data \+ \d+ \+ (\d+)/g, + ), + ].map((m) => [parseInt(m[1], 10), parseInt(m[1], 10) + parseInt(m[2], 10)]); + assert.ok(pairs.length > 0, "no entries found in data.c"); + let cursor = 0; + for (const [start, end] of pairs) { + assert.equal(start, cursor, `gap before offset ${cursor}`); + assert.ok(end > start, `zero-length span at offset ${start}`); + cursor = end; + } + assert.equal(cursor, bin.length, "last file end does not reach bin size"); + } finally { + cleanup(out, dir); + } +}); + +test("uncompressed entries have codec=0 and decompressed_size=0", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + makeTestCorpus(dir); + runSfs(dir, out); + const src = fs.readFileSync(derivedPaths(out).dataC, "utf8"); + // Each entry ends in ", 0, 0 }," where the two zeros are decompressed_size and codec + const entries = [...src.matchAll(/\{[^}]+,\s*(\d+),\s*(\d+)\s*\}/g)]; + assert.ok(entries.length > 0, "no entries found"); + for (const m of entries) { + assert.equal(m[1], "0", `decompressed_size expected 0, got ${m[1]}`); + assert.equal(m[2], "0", `codec expected 0, got ${m[2]}`); + } + } finally { + cleanup(out, dir); + } +}); + +test("binary blob contains original file bytes in sorted order", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + const corpus = makeTestCorpus(dir); + runSfs(dir, out); + const bin = fs.readFileSync(derivedPaths(out).dataBin); + const expected = Buffer.concat(corpus.files.map((f) => corpus.contents[f])); + assert.deepEqual( + bin, + expected, + "binary blob bytes do not match concatenated files", + ); + } finally { + cleanup(out, dir); + } +}); + +test("--skip regex excludes matching files", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + makeTestCorpus(dir); + runSfs(dir, out, ["--skip", "\\.pm$"]); + const src = fs.readFileSync(derivedPaths(out).dataC, "utf8"); + assert.ok(!src.includes('.pm"'), ".pm files were not skipped"); + assert.ok(src.includes("run.pl"), "run.pl is missing after skip"); + } finally { + cleanup(out, dir); + } +}); + +test("dotfiles are excluded", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + makeTestCorpus(dir); + fs.writeFileSync(path.join(dir, ".DS_Store"), "junk"); + fs.writeFileSync(path.join(dir, "lib/5.42.2/.hidden"), "secret"); + runSfs(dir, out); + const src = fs.readFileSync(derivedPaths(out).dataC, "utf8"); + assert.ok(!src.includes(".DS_Store"), "dotfile .DS_Store was not excluded"); + assert.ok(!src.includes(".hidden"), "dotfile .hidden was not excluded"); + } finally { + cleanup(out, dir); + } +}); + +test("generated C source embeds original file contents correctly", () => { + // Run sfs.js twice on the same corpus and compare -- ensures determinism + const dir = makeTmpDir(); + const outA = makeTmpHeader(); + const outB = outA.replace(".h", "_b.h"); + try { + makeTestCorpus(dir); + runSfs(dir, outA); + runSfs(dir, outB); + const binA = fs.readFileSync(derivedPaths(outA).dataBin); + const binB = fs.readFileSync(derivedPaths(outB).dataBin); + assert.deepEqual(binA, binB, "non-deterministic binary output"); + const srcA = fs.readFileSync(derivedPaths(outA).dataC, "utf8"); + const srcB = fs.readFileSync(derivedPaths(outB).dataC, "utf8"); + // Replace auto-generated paths (tmp dirs differ) before comparing structure + const normalize = (s) => s.replace(/sfs-gen-test-[^"]+/g, "TMPDIR"); + assert.equal(normalize(srcA), normalize(srcB), "non-deterministic data.c"); + } finally { + cleanup(outA, dir); + cleanup(outB); + } +}); + +// --------------------------------------------------------------------------- +// Summary +// --------------------------------------------------------------------------- +// --------------------------------------------------------------------------- +// Phase 3: --compress mode +// --------------------------------------------------------------------------- + +test("--compress: codec=1 for all entries", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + makeTestCorpus(dir); + runSfsWithEnv(dir, out, ["--compress"], nodeOnlyEnv()); + const src = fs.readFileSync(derivedPaths(out).dataC, "utf8"); + const entries = [...src.matchAll(/\{[^}]+,\s*(\d+),\s*(\d+)\s*\}/g)]; + assert.ok(entries.length > 0, "no entries found"); + for (const m of entries) { + assert.equal(m[2], "1", `codec expected 1, got ${m[2]}`); + } + } finally { + cleanup(out, dir); + } +}); + +test("--compress: decompressed_size matches original file sizes", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + makeTestCorpus(dir); + runSfsWithEnv(dir, out, ["--compress"], nodeOnlyEnv()); + const src = fs.readFileSync(derivedPaths(out).dataC, "utf8"); + // Parse entries: { "path", start, start+len, decompressed_size, codec } + const rows = [ + ...src.matchAll( + /\{\s*"([^"]+)",\s*sfs_builtin_data \+ (\d+),\s*sfs_builtin_data \+ \d+ \+ (\d+),\s*(\d+),\s*(\d+)\s*\}/g, + ), + ]; + assert.ok(rows.length > 0, "no entries found"); + for (const m of rows) { + const decompressedSize = parseInt(m[4], 10); + assert.ok( + decompressedSize > 0, + `decompressed_size should be > 0, got ${decompressedSize}`, + ); + } + } finally { + cleanup(out, dir); + } +}); + +test("--compress: decompressed_size matches original content length", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + const corpus = makeTestCorpus(dir); + runSfsWithEnv(dir, out, ["--compress"], nodeOnlyEnv()); + const src = fs.readFileSync(derivedPaths(out).dataC, "utf8"); + const rows = [ + ...src.matchAll( + /\{\s*"([^"]+)",\s*sfs_builtin_data \+ (\d+),\s*sfs_builtin_data \+ \d+ \+ (\d+),\s*(\d+),\s*(\d+)\s*\}/g, + ), + ]; + assert.ok( + rows.length === corpus.files.length, + `expected ${corpus.files.length} entries, got ${rows.length}`, + ); + for (const m of rows) { + // m[1]=abspath, m[2]=start, m[3]=len, m[4]=decompressed_size, m[5]=codec + const abspath = m[1]; + const decompressedSize = parseInt(m[4], 10); + // Find matching corpus file + const relKey = corpus.files.find((f) => abspath.endsWith(f)); + assert.ok(relKey, `corpus entry not found for ${abspath}`); + const originalLen = corpus.contents[relKey].length; + assert.equal( + decompressedSize, + originalLen, + `decompressed_size mismatch for ${relKey}: expected ${originalLen}, got ${decompressedSize}`, + ); + } + } finally { + cleanup(out, dir); + } +}); + +test("--compress: compressed spans have no gaps or overlaps", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + makeTestCorpus(dir); + runSfsWithEnv(dir, out, ["--compress"], nodeOnlyEnv()); + const src = fs.readFileSync(derivedPaths(out).dataC, "utf8"); + const bin = fs.readFileSync(derivedPaths(out).dataBin); + const pairs = [ + ...src.matchAll( + /sfs_builtin_data \+ (\d+), sfs_builtin_data \+ \d+ \+ (\d+)/g, + ), + ].map((m) => [parseInt(m[1], 10), parseInt(m[1], 10) + parseInt(m[2], 10)]); + assert.ok(pairs.length > 0, "no entries found"); + let cursor = 0; + for (const [start, end] of pairs) { + assert.equal(start, cursor, `gap before offset ${cursor}`); + assert.ok(end > start, `zero-length span at offset ${start}`); + cursor = end; + } + assert.equal(cursor, bin.length, "last file end does not reach bin size"); + } finally { + cleanup(out, dir); + } +}); + +test("--compress: succeeds without lz4 CLI on PATH", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + makeTestCorpus(dir); + runSfsWithEnv(dir, out, ["--compress"], nodeOnlyEnv()); + assert.ok( + fs.existsSync(derivedPaths(out).dataBin), + "compressed data.bin missing", + ); + } finally { + cleanup(out, dir); + } +}); + +test("--compress: compressed data decompresses to original content", () => { + const dir = makeTmpDir(); + const out = makeTmpHeader(); + try { + const corpus = makeTestCorpus(dir); + runSfsWithEnv(dir, out, ["--compress"], nodeOnlyEnv()); + const src = fs.readFileSync(derivedPaths(out).dataC, "utf8"); + const bin = fs.readFileSync(derivedPaths(out).dataBin); + const rows = [ + ...src.matchAll( + /\{\s*"([^"]+)",\s*sfs_builtin_data \+ (\d+),\s*sfs_builtin_data \+ \d+ \+ (\d+),\s*(\d+),\s*(\d+)\s*\}/g, + ), + ]; + assert.ok(rows.length > 0, "no entries found"); + for (const m of rows) { + const abspath = m[1]; + const startOff = parseInt(m[2], 10); + const compLen = parseInt(m[3], 10); + const decompSz = parseInt(m[4], 10); + const codec = parseInt(m[5], 10); + assert.equal(codec, 1, `expected codec=1 for ${abspath}`); + const compSlice = bin.slice(startOff, startOff + compLen); + const decompBuf = lz4.decode(compSlice); + const n = decompBuf.length; + assert.equal( + n, + decompSz, + `decompressed ${n} bytes, expected ${decompSz}`, + ); + const relKey = corpus.files.find((f) => abspath.endsWith(f)); + assert.ok(relKey, `corpus key not found for ${abspath}`); + assert.deepEqual( + decompBuf, + corpus.contents[relKey], + `content mismatch for ${relKey}`, + ); + } + } finally { + cleanup(out, dir); + } +}); + +console.log(`\n${passed + failed} tests: ${passed} passed, ${failed} failed`); +if (failed > 0) process.exit(1); diff --git a/tests/sfs/test-sfs.c b/tests/sfs/test-sfs.c new file mode 100644 index 0000000..24a4ecd --- /dev/null +++ b/tests/sfs/test-sfs.c @@ -0,0 +1,681 @@ +/* + * tests/sfs/test-sfs.c + * Unit tests for production SFS runtime and compression modules. + */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +/* + * Local mirror of the sfs_entry struct defined in the generated header. + * We keep our own copy so the test harness does not depend on a specific + * zeroperl.h generation (the struct layout is stable). + */ +struct sfs_entry { + const char *abspath; + const unsigned char *start; + const unsigned char *end; + uint32_t decompressed_size; + uint8_t codec; +}; + +#ifndef SFS_LRU_MAX +#define SFS_LRU_MAX 8 +#endif + +#ifndef SFS_LRU_CAP_BYTES +#define SFS_LRU_CAP_BYTES 256 +#endif + +#include "../../stubs/sfs_runtime.h" + +static int g_passed = 0; +static int g_failed = 0; + +static void t_ok(int cond, const char *msg) { + if (cond) { + printf(" PASS: %s\n", msg); + g_passed++; + } else { + printf(" FAIL: %s\n", msg); + g_failed++; + } +} + +#define T_OK(cond) t_ok((cond), #cond) +#define T_EQ(a, b) t_ok((a) == (b), #a " == " #b) +#define T_STR_EQ(a, b) t_ok(strcmp((a), (b)) == 0, #a " == " #b) + +static unsigned char *compress_frame(const unsigned char *src, size_t src_len, + size_t *out_len) { + size_t cap = LZ4F_compressFrameBound(src_len, NULL); + unsigned char *buf = (unsigned char *)malloc(cap); + if (!buf) { + return NULL; + } + size_t written = LZ4F_compressFrame(buf, cap, src, src_len, NULL); + if (LZ4F_isError(written)) { + free(buf); + errno = EIO; + return NULL; + } + *out_len = written; + return buf; +} + +static bool cache_has_path(const SfsCache *cache, const char *path) { + for (int i = 0; i < SFS_LRU_MAX; i++) { + if (cache->entries[i].abspath && strcmp(cache->entries[i].abspath, path) == 0) { + return true; + } + } + return false; +} + +static void test_access_found_and_missing(void) { + printf("\n--- access ---\n"); + SfsRuntime runtime; + sfs_runtime_init(&runtime, "/zeroperl"); + + static const unsigned char raw[] = "package Carp; 1;\n"; + struct sfs_entry entries[] = {{ + .abspath = "/zeroperl/lib/Carp.pm", + .start = raw, + .end = raw + sizeof(raw) - 1, + .decompressed_size = 0, + .codec = 0, + }}; + + errno = 0; + T_EQ(sfs_runtime_access(&runtime, entries, 1, "/zeroperl/lib/Carp.pm"), 0); + errno = 0; + T_EQ(sfs_runtime_access(&runtime, entries, 1, "/zeroperl//lib/Carp.pm"), 0); + errno = 0; + T_EQ(sfs_runtime_access(&runtime, entries, 1, "/zeroperl/lib/Missing.pm"), -1); + T_EQ(errno, ENOENT); + + sfs_runtime_dispose(&runtime); +} + +static void test_open_read_close_uncompressed(void) { + printf("\n--- open/read/close uncompressed ---\n"); + SfsRuntime runtime; + sfs_runtime_init(&runtime, "/zeroperl"); + + static const unsigned char raw[] = "package Carp; 1;\n"; + struct sfs_entry entries[] = {{ + .abspath = "/zeroperl/lib/Carp.pm", + .start = raw, + .end = raw + sizeof(raw) - 1, + .decompressed_size = 0, + .codec = 0, + }}; + + FILE *fp = NULL; + int fd = sfs_runtime_open(&runtime, entries, 1, "/zeroperl/lib/Carp.pm", &fp); + T_OK(fd >= 0); + T_OK(fp != NULL); + T_EQ(sfs_runtime_fileno(&runtime, fp), fd); + + char buf[64] = {0}; + ssize_t n = sfs_runtime_read(&runtime, fd, buf, 7); + T_EQ(n, 7); + T_OK(memcmp(buf, raw, 7) == 0); + + T_EQ(sfs_runtime_lseek(&runtime, fd, -2, SEEK_END), (off_t)(sizeof(raw) - 3)); + memset(buf, 0, sizeof(buf)); + n = sfs_runtime_read(&runtime, fd, buf, 8); + T_EQ(n, 2); + T_OK(memcmp(buf, raw + (sizeof(raw) - 3), 2) == 0); + T_EQ(sfs_runtime_read(&runtime, fd, buf, 8), 0); + + T_EQ(sfs_runtime_lseek(&runtime, fd, 0, SEEK_SET), 0); + memset(buf, 0, sizeof(buf)); + n = sfs_runtime_read(&runtime, fd, buf, sizeof(buf) - 1); + T_EQ((size_t)n, sizeof(raw) - 1); + T_STR_EQ(buf, (const char *)raw); + + T_EQ(sfs_runtime_close(&runtime, fd), SFS_OK); + T_EQ(sfs_runtime_close(&runtime, fd), SFS_NOT_OURS); + + sfs_runtime_dispose(&runtime); +} + +static void test_virtual_fd_namespace_avoids_low_fds(void) { + printf("\n--- virtual fd namespace avoids low fds ---\n"); + SfsRuntime runtime; + sfs_runtime_init(&runtime, "/zeroperl"); + + static const unsigned char raw[] = "package Carp; 1;\n"; + struct sfs_entry entries[] = {{ + .abspath = "/zeroperl/lib/Carp.pm", + .start = raw, + .end = raw + sizeof(raw) - 1, + .decompressed_size = 0, + .codec = 0, + }}; + + FILE *fp = NULL; + int fd = sfs_runtime_open(&runtime, entries, 1, "/zeroperl/lib/Carp.pm", &fp); + T_OK(fd >= SFS_VIRTUAL_FD_BASE); + T_EQ(sfs_runtime_fileno(&runtime, fp), fd); + T_EQ(sfs_runtime_close(&runtime, fd), SFS_OK); + + sfs_runtime_dispose(&runtime); +} + +static void test_open_read_stat_compressed(void) { + printf("\n--- open/read/stat compressed ---\n"); + SfsRuntime runtime; + sfs_runtime_init(&runtime, "/zeroperl"); + + static const unsigned char raw[] = "package Image::ExifTool; 1;\n"; + size_t comp_len = 0; + unsigned char *comp = compress_frame(raw, sizeof(raw) - 1, &comp_len); + T_OK(comp != NULL); + if (!comp) { + sfs_runtime_dispose(&runtime); + return; + } + + struct sfs_entry entries[] = {{ + .abspath = "/zeroperl/lib/site_perl/Image/ExifTool.pm", + .start = comp, + .end = comp + comp_len, + .decompressed_size = sizeof(raw) - 1, + .codec = 1, + }}; + + struct stat st; + T_EQ(sfs_runtime_stat(&runtime, entries, 1, + "/zeroperl/lib/site_perl/Image/ExifTool.pm", -1, &st), + SFS_STAT_OURS); + T_EQ((size_t)st.st_size, sizeof(raw) - 1); + T_EQ((st.st_mode & S_IFMT), S_IFREG); + memset(&st, 0, sizeof(st)); + T_EQ(sfs_runtime_stat(&runtime, entries, 1, + "/zeroperl//lib/site_perl/Image/ExifTool.pm", -1, + &st), + SFS_STAT_OURS); + T_EQ((size_t)st.st_size, sizeof(raw) - 1); + T_EQ((st.st_mode & S_IFMT), S_IFREG); + + FILE *fp = NULL; + int fd = sfs_runtime_open(&runtime, entries, 1, + "/zeroperl//lib/site_perl/Image/ExifTool.pm", &fp); + T_OK(fd >= 0); + + char buf[64] = {0}; + ssize_t n = sfs_runtime_read(&runtime, fd, buf, sizeof(buf) - 1); + T_EQ((size_t)n, sizeof(raw) - 1); + T_STR_EQ(buf, (const char *)raw); + + memset(&st, 0, sizeof(st)); + T_EQ(sfs_runtime_stat(&runtime, entries, 1, NULL, fd, &st), SFS_STAT_OURS); + T_EQ((size_t)st.st_size, sizeof(raw) - 1); + T_EQ((st.st_mode & S_IFMT), S_IFREG); + + T_EQ(sfs_runtime_close(&runtime, fd), SFS_OK); + + free(comp); + sfs_runtime_dispose(&runtime); +} + +static void test_bad_compressed_open_fails(void) { + printf("\n--- bad compressed open fails ---\n"); + SfsRuntime runtime; + sfs_runtime_init(&runtime, "/zeroperl"); + + static const unsigned char bad[] = {0x00, 0x01, 0x02, 0x03}; + struct sfs_entry entries[] = {{ + .abspath = "/zeroperl/lib/Bad.pm", + .start = bad, + .end = bad + sizeof(bad), + .decompressed_size = 32, + .codec = 1, + }}; + + errno = 0; + T_EQ(sfs_runtime_open(&runtime, entries, 1, "/zeroperl/lib/Bad.pm", NULL), -1); + T_EQ(errno, EIO); + + sfs_runtime_dispose(&runtime); +} + +static void test_lseek_and_emfile(void) { + printf("\n--- lseek and emfile ---\n"); + SfsRuntime runtime; + sfs_runtime_init(&runtime, "/zeroperl"); + + static const unsigned char raw[] = "#!/usr/bin/perl\n"; + struct sfs_entry entry = { + .abspath = "/zeroperl/run.pl", + .start = raw, + .end = raw + sizeof(raw) - 1, + .decompressed_size = 0, + .codec = 0, + }; + + for (int i = 0; i < SFS_MAX_OPEN_FILES; i++) { + FILE *fp = NULL; + int fd = sfs_runtime_open(&runtime, &entry, 1, "/zeroperl/run.pl", &fp); + T_OK(fd >= 0); + } + + errno = 0; + T_EQ(sfs_runtime_open(&runtime, &entry, 1, "/zeroperl/run.pl", NULL), -1); + T_EQ(errno, EMFILE); + + sfs_runtime_dispose(&runtime); + + sfs_runtime_init(&runtime, "/zeroperl"); + FILE *fp = NULL; + int fd = sfs_runtime_open(&runtime, &entry, 1, "/zeroperl/run.pl", &fp); + T_OK(fd >= 0); + T_EQ(sfs_runtime_lseek(&runtime, fd, 0, SEEK_END), (off_t)(sizeof(raw) - 1)); + T_EQ(sfs_runtime_lseek(&runtime, fd, 0, SEEK_SET), 0); + T_EQ(sfs_runtime_lseek(&runtime, fd, 4, SEEK_SET), 4); + T_EQ(sfs_runtime_lseek(&runtime, fd, 3, SEEK_CUR), 7); + T_EQ(sfs_runtime_close(&runtime, fd), SFS_OK); + sfs_runtime_dispose(&runtime); +} + +static void test_cache_key_uses_string_equality(void) { + printf("\n--- cache key uses string equality ---\n"); + + static const unsigned char raw[] = "package Cache::Key; 1;\n"; + size_t comp_len = 0; + unsigned char *comp = compress_frame(raw, sizeof(raw) - 1, &comp_len); + T_OK(comp != NULL); + if (!comp) { + return; + } + + char *p1 = strdup("/zeroperl/lib/Cache/Key.pm"); + char *p2 = strdup("/zeroperl/lib/Cache/Key.pm"); + T_OK(p1 != NULL && p2 != NULL); + if (!p1 || !p2) { + free(p1); + free(p2); + free(comp); + return; + } + + struct sfs_entry e1 = { + .abspath = p1, + .start = comp, + .end = comp + comp_len, + .decompressed_size = sizeof(raw) - 1, + .codec = 1, + }; + struct sfs_entry e2 = { + .abspath = p2, + .start = comp, + .end = comp + comp_len, + .decompressed_size = sizeof(raw) - 1, + .codec = 1, + }; + + SfsCache cache; + sfs_cache_init(&cache); + + const unsigned char *d1 = NULL; + size_t n1 = 0; + SfsLruEntry *h1 = NULL; + unsigned char *owned1 = NULL; + T_EQ(sfs_entry_materialize(&cache, &e1, &d1, &n1, &h1, &owned1), 0); + T_OK(h1 != NULL); + T_OK(owned1 == NULL); + + const unsigned char *d2 = NULL; + size_t n2 = 0; + SfsLruEntry *h2 = NULL; + unsigned char *owned2 = NULL; + T_EQ(sfs_entry_materialize(&cache, &e2, &d2, &n2, &h2, &owned2), 0); + T_OK(h2 != NULL); + T_OK(owned2 == NULL); + T_OK(h1 == h2); + T_OK(d1 == d2); + + sfs_cache_release(h2); + sfs_cache_release(h1); + sfs_cache_dispose(&cache); + free(p1); + free(p2); + free(comp); +} + +static void test_cache_saturation_degrades_without_failure(void) { + printf("\n--- cache saturation degrades without failure ---\n"); + + SfsRuntime runtime; + sfs_runtime_init(&runtime, "/zeroperl"); + + struct sfs_entry entries[SFS_LRU_MAX + 1]; + unsigned char *comp_bufs[SFS_LRU_MAX + 1] = {0}; + int fds[SFS_LRU_MAX + 1]; + memset(fds, -1, sizeof(fds)); + + char raw[64]; + for (int i = 0; i < SFS_LRU_MAX + 1; i++) { + int n = snprintf(raw, sizeof(raw), "package P%04d; 1;\n", i); + size_t comp_len = 0; + comp_bufs[i] = compress_frame((const unsigned char *)raw, (size_t)n, &comp_len); + T_OK(comp_bufs[i] != NULL); + if (!comp_bufs[i]) { + continue; + } + + char *path = (char *)malloc(64); + T_OK(path != NULL); + if (!path) { + continue; + } + snprintf(path, 64, "/zeroperl/lib/P%04d.pm", i); + + entries[i] = (struct sfs_entry){ + .abspath = path, + .start = comp_bufs[i], + .end = comp_bufs[i] + comp_len, + .decompressed_size = (uint32_t)n, + .codec = 1, + }; + } + + for (int i = 0; i < SFS_LRU_MAX; i++) { + FILE *fp = NULL; + fds[i] = sfs_runtime_open(&runtime, entries, SFS_LRU_MAX + 1, entries[i].abspath, + &fp); + T_OK(fds[i] >= 0); + T_OK(fp != NULL); + } + + size_t bytes_before = runtime.cache.bytes; + FILE *last_fp = NULL; + fds[SFS_LRU_MAX] = sfs_runtime_open(&runtime, entries, SFS_LRU_MAX + 1, + entries[SFS_LRU_MAX].abspath, &last_fp); + T_OK(fds[SFS_LRU_MAX] >= 0); + T_OK(last_fp != NULL); + + SfsOpenFile *sat_slot = NULL; + for (int i = 0; i < SFS_MAX_OPEN_FILES; i++) { + if (runtime.table[i].used && runtime.table[i].fd == fds[SFS_LRU_MAX]) { + sat_slot = &runtime.table[i]; + break; + } + } + T_OK(sat_slot != NULL); + if (sat_slot) { + T_OK(sat_slot->lru == NULL); + T_OK(sat_slot->owned_data != NULL); + } + T_OK(runtime.cache.bytes <= SFS_LRU_CAP_BYTES); + T_EQ(runtime.cache.bytes, bytes_before); + + for (int i = 0; i < SFS_LRU_MAX + 1; i++) { + if (fds[i] >= 0) { + T_EQ(sfs_runtime_close(&runtime, fds[i]), SFS_OK); + } + } + + for (int i = 0; i < SFS_LRU_MAX + 1; i++) { + free((void *)entries[i].abspath); + free(comp_bufs[i]); + } + sfs_runtime_dispose(&runtime); +} + +static void test_cache_cap_soft_when_entries_pinned(void) { + printf("\n--- cache cap soft with pinned entries ---\n"); + + SfsRuntime runtime; + sfs_runtime_init(&runtime, "/zeroperl"); + + static const unsigned char raw1[] = + "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" + "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" + "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"; + static const unsigned char raw2[] = + "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB" + "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB" + "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB"; + + size_t comp1_len = 0; + size_t comp2_len = 0; + unsigned char *comp1 = compress_frame(raw1, sizeof(raw1) - 1, &comp1_len); + unsigned char *comp2 = compress_frame(raw2, sizeof(raw2) - 1, &comp2_len); + T_OK(comp1 != NULL); + T_OK(comp2 != NULL); + if (!comp1 || !comp2) { + free(comp1); + free(comp2); + sfs_runtime_dispose(&runtime); + return; + } + + struct sfs_entry entries[] = { + { + .abspath = "/zeroperl/lib/CapOne.pm", + .start = comp1, + .end = comp1 + comp1_len, + .decompressed_size = sizeof(raw1) - 1, + .codec = 1, + }, + { + .abspath = "/zeroperl/lib/CapTwo.pm", + .start = comp2, + .end = comp2 + comp2_len, + .decompressed_size = sizeof(raw2) - 1, + .codec = 1, + }, + }; + + FILE *fp1 = NULL; + int fd1 = sfs_runtime_open(&runtime, entries, 2, entries[0].abspath, &fp1); + T_OK(fd1 >= 0); + T_OK(fp1 != NULL); + + size_t bytes_after_first = runtime.cache.bytes; + T_OK(bytes_after_first <= SFS_LRU_CAP_BYTES); + + FILE *fp2 = NULL; + int fd2 = sfs_runtime_open(&runtime, entries, 2, entries[1].abspath, &fp2); + T_OK(fd2 >= 0); + T_OK(fp2 != NULL); + T_OK(runtime.cache.bytes <= SFS_LRU_CAP_BYTES); + + SfsOpenFile *slot2 = NULL; + for (int i = 0; i < SFS_MAX_OPEN_FILES; i++) { + if (runtime.table[i].used && runtime.table[i].fd == fd2) { + slot2 = &runtime.table[i]; + break; + } + } + T_OK(slot2 != NULL); + if (slot2) { + T_OK(slot2->lru == NULL); + T_OK(slot2->owned_data != NULL); + } + + T_EQ(sfs_runtime_close(&runtime, fd2), SFS_OK); + T_EQ(sfs_runtime_close(&runtime, fd1), SFS_OK); + + free(comp1); + free(comp2); + sfs_runtime_dispose(&runtime); +} + +static void test_cache_evicts_oldest_unref_entry_under_cap(void) { + printf("\n--- cache evicts oldest unreferenced entry under cap ---\n"); + + static const unsigned char raw1[] = + "111111111111111111111111111111111111111111111111111111111111111111111111" + "111111111111111111111111111111111111111111111111"; + static const unsigned char raw2[] = + "222222222222222222222222222222222222222222222222222222222222222222222222" + "222222222222222222222222222222222222222222222222"; + static const unsigned char raw3[] = + "333333333333333333333333333333333333333333333333333333333333333333333333" + "333333333333333333333333333333333333333333333333"; + + size_t c1_len = 0; + size_t c2_len = 0; + size_t c3_len = 0; + unsigned char *c1 = compress_frame(raw1, sizeof(raw1) - 1, &c1_len); + unsigned char *c2 = compress_frame(raw2, sizeof(raw2) - 1, &c2_len); + unsigned char *c3 = compress_frame(raw3, sizeof(raw3) - 1, &c3_len); + T_OK(c1 != NULL); + T_OK(c2 != NULL); + T_OK(c3 != NULL); + if (!c1 || !c2 || !c3) { + free(c1); + free(c2); + free(c3); + return; + } + + struct sfs_entry e1 = { + .abspath = "/zeroperl/lib/EvictOne.pm", + .start = c1, + .end = c1 + c1_len, + .decompressed_size = sizeof(raw1) - 1, + .codec = 1, + }; + struct sfs_entry e2 = { + .abspath = "/zeroperl/lib/EvictTwo.pm", + .start = c2, + .end = c2 + c2_len, + .decompressed_size = sizeof(raw2) - 1, + .codec = 1, + }; + struct sfs_entry e3 = { + .abspath = "/zeroperl/lib/EvictThree.pm", + .start = c3, + .end = c3 + c3_len, + .decompressed_size = sizeof(raw3) - 1, + .codec = 1, + }; + + SfsCache cache; + sfs_cache_init(&cache); + + const unsigned char *d = NULL; + size_t n = 0; + SfsLruEntry *h = NULL; + unsigned char *owned = NULL; + + T_EQ(sfs_entry_materialize(&cache, &e1, &d, &n, &h, &owned), 0); + T_OK(h != NULL); + T_OK(owned == NULL); + sfs_cache_release(h); + + h = NULL; + T_EQ(sfs_entry_materialize(&cache, &e2, &d, &n, &h, &owned), 0); + T_OK(h != NULL); + T_OK(owned == NULL); + sfs_cache_release(h); + + T_OK(cache_has_path(&cache, e1.abspath)); + T_OK(cache_has_path(&cache, e2.abspath)); + T_OK(cache.bytes <= SFS_LRU_CAP_BYTES); + + h = NULL; + T_EQ(sfs_entry_materialize(&cache, &e3, &d, &n, &h, &owned), 0); + T_OK(h != NULL); + T_OK(owned == NULL); + sfs_cache_release(h); + + T_OK(!cache_has_path(&cache, e1.abspath)); + T_OK(cache_has_path(&cache, e2.abspath)); + T_OK(cache_has_path(&cache, e3.abspath)); + T_OK(cache.bytes <= SFS_LRU_CAP_BYTES); + + sfs_cache_dispose(&cache); + free(c1); + free(c2); + free(c3); +} + +static void test_system_open_nonexistent_propagates_enoent(void) { + printf("\n--- system open nonexistent propagates ENOENT ---\n"); + + // Keep path generation deterministic and dependency-free for lint/test runs. + static unsigned long no_such_file_seq = 0; + char path[256]; + snprintf(path, sizeof(path), "/tmp/sfs-no-such-file-%ld-%lu", (long)getpid(), + ++no_such_file_seq); + + errno = 0; + int fd = open(path, O_RDONLY); + T_EQ(fd, -1); + T_EQ(errno, ENOENT); +} + +static void test_system_open_unreadable_propagates_permission(void) { + printf("\n--- system open unreadable propagates permission ---\n"); + + if (getuid() == 0) { + printf(" SKIP: running as root — permission tests are meaningless\n"); + return; + } + + char tmpl[] = "/tmp/sfs-no-read-XXXXXX"; + int fd = mkstemp(tmpl); + T_OK(fd >= 0); + if (fd < 0) { + return; + } + + static const char payload[] = "x"; + ssize_t wrote = write(fd, payload, sizeof(payload)); + T_OK(wrote >= 0); + T_EQ(close(fd), 0); + + T_EQ(chmod(tmpl, 0333), 0); + + errno = 0; + int rd = open(tmpl, O_RDONLY); + T_EQ(rd, -1); + T_OK(errno == EACCES || errno == EPERM); + + (void)chmod(tmpl, 0600); + (void)unlink(tmpl); +} + +/* + * Test suite entry point. + * + * Tests are organised into four groups: + * 1. Basic access / open / read / close (uncompressed and compressed) + * 2. Virtual FD namespace and edge cases (EMFILE, bad data) + * 3. LRU cache behaviour (string keys, saturation, pinning, eviction) + * 4. System call pass-through (ENOENT, permission denied) + */ +int main(void) { + printf("tests/sfs/test-sfs.c\n"); + printf("==============================\n"); + + test_access_found_and_missing(); + test_open_read_close_uncompressed(); + test_virtual_fd_namespace_avoids_low_fds(); + test_open_read_stat_compressed(); + test_bad_compressed_open_fails(); + test_lseek_and_emfile(); + test_cache_key_uses_string_equality(); + test_cache_saturation_degrades_without_failure(); + test_cache_cap_soft_when_entries_pinned(); + test_cache_evicts_oldest_unref_entry_under_cap(); + test_system_open_nonexistent_propagates_enoent(); + test_system_open_unreadable_propagates_permission(); + + printf("\nSummary: %d passed, %d failed\n", g_passed, g_failed); + return g_failed ? 1 : 0; +} diff --git a/tests/smoke/core-mod-smoke.pl b/tests/smoke/core-mod-smoke.pl new file mode 100644 index 0000000..67f9c46 --- /dev/null +++ b/tests/smoke/core-mod-smoke.pl @@ -0,0 +1,24 @@ +#!/usr/bin/perl +# Core module smoke test — exercises core Perl modules via Core::TestMod. +# Prints "CORE_SMOKE_OK" on success, dies with diagnostics on failure. + +use strict; +use warnings; +$| = 1; + +use Core::TestMod; + +print "perl version: $^V\n"; + +my ($errors, $skipped) = Core::TestMod::run(); + +if (@$errors) { + print STDERR "CORE_SMOKE_ERRORS:\n"; + print STDERR " $_\n" for @$errors; + exit 1; +} + +print "CORE_SMOKE_OK\n"; +if (@$skipped) { + print "CORE_SMOKE_SKIPPED: ", join(', ', @$skipped), "\n"; +} diff --git a/tests/smoke/core-smoke.pl b/tests/smoke/core-smoke.pl new file mode 100644 index 0000000..dc77011 --- /dev/null +++ b/tests/smoke/core-smoke.pl @@ -0,0 +1,159 @@ +#!/usr/bin/perl +# Core smoke test — exercises core Perl modules available across all +# supported Perl versions (5.16.3+) in the zeroperl WASM build. +# Prints "CORE_SMOKE_OK" on success, dies with diagnostics on failure. +# +# Modules are tested in tiers: +# Tier 1 — must work on every version (strict, warnings, Digest::MD5, etc.) +# Tier 2 — version/feature-dependent (File::Spec, Data::Dumper, IO::File, etc.) +# tested conditionally; failures are errors only when the feature +# should be present. + +use strict; +use warnings; +$| = 1; + +my @errors; +my @skipped; + +print "perl version: $^V\n"; + +# ── Tier 1: universal core ────────────────────────────────────────────────── + +# Digest::MD5 (XS, core since 5.8) +eval { + require Digest::MD5; + my $md5 = Digest::MD5::md5_hex('zeroperl'); + die "Digest::MD5" unless length($md5) == 32; + 1; +} or push @errors, "Digest::MD5: $@"; + +# List::Util (XS, core since 5.8) +eval { + require List::Util; + my $sum = List::Util::sum(1, 2, 3, 4, 5); + die "List::Util::sum" unless $sum == 15; + 1; +} or push @errors, "List::Util: $@"; + +# Cwd (XS, core since 5.4) +eval { + require Cwd; + my $cwd = Cwd::getcwd(); + die "Cwd::getcwd" unless defined $cwd && length($cwd) > 0; + 1; +} or push @errors, "Cwd: $@"; + +# Fcntl (XS, core since 5.4) +eval { + require Fcntl; + my $ok = defined &Fcntl::O_RDONLY; + die "Fcntl::O_RDONLY" unless $ok; + 1; +} or push @errors, "Fcntl: $@"; + +# MIME::Base64 (XS, core since 5.8) +eval { + require MIME::Base64; + my $enc = MIME::Base64::encode_base64('hello'); + my $dec = MIME::Base64::decode_base64($enc); + die "MIME::Base64 roundtrip" unless $dec eq 'hello'; + 1; +} or push @errors, "MIME::Base64: $@"; + +# Basic regex and string ops (core language, no module needed) +eval { + my $s = "Hello, World!"; + die "regex match" unless $s =~ /World/; + my $r = $s =~ s/World/Perl/r; + die "regex subst" unless $r eq "Hello, Perl!"; + die "split/join" unless join(':', split(/,/, "a,b,c")) eq "a:b:c"; + 1; +} or push @errors, "regex/string: $@"; + +# ── Tier 2: version-conditional ────────────────────────────────────────────── + +# File::Spec — core since 5.5, but may be stripped by wasm-opt in full-shrink +# builds or missing from the embedded SFS. +eval { + require File::Spec; + my $cat = File::Spec->catfile('a', 'b', 'c'); + die "File::Spec->catfile" unless $cat && $cat =~ m{a}; + 1; +} or do { + push @skipped, "File::Spec"; +}; + +# Data::Dumper — core since 5.6, but depends on constant.pm which depends on +# unicore/Heavy.pl (via utf8_heavy.pl) on Perl < 5.18. The unicore directory +# is trimmed from the prefix in some builds. +eval { + require Data::Dumper; + my $s = Data::Dumper::Dumper([1, 2, 3]); + die "Data::Dumper" unless $s && $s =~ /\d/; + 1; +} or do { + push @skipped, "Data::Dumper"; +}; + +# IO::File — core since 5.4, but new_tmpfile does not work in WASI (no tmpdir). +# Test file I/O via in-memory write/read on an explicit file path instead. +eval { + require IO::File; + my $fh = IO::File->new('/work/_smoke_tmp', 'w'); + die "IO::File->new(w)" unless $fh; + print $fh "test\n"; + $fh->close; + $fh = IO::File->new('/work/_smoke_tmp', 'r'); + die "IO::File->new(r)" unless $fh; + my $line = <$fh>; + $fh->close; + die "IO::File roundtrip" unless $line eq "test\n"; + 1; +} or do { + push @skipped, "IO::File"; +}; + +# Encode — core since 5.8, but depends on unicore/Heavy.pl on older perls. +eval { + require Encode; + my $enc = Encode::encode('UTF-8', 'hello'); + my $dec = Encode::decode('UTF-8', $enc); + die "Encode roundtrip" unless $dec eq 'hello'; + 1; +} or do { + push @skipped, "Encode"; +}; + +# File::Glob — core since 5.6, may be stripped or unavailable. +eval { + require File::Glob; + my @files = File::Glob::bsd_glob('*'); + die "File::Glob" unless @files >= 0; + 1; +} or do { + push @skipped, "File::Glob"; +}; + +# POSIX — not built in the WASI configuration (noextensions). +eval { + require POSIX; + my $ceil = POSIX::ceil(1.5); + die "POSIX::ceil" unless $ceil == 2; + 1; +} or do { + push @skipped, "POSIX"; +}; + +# ── Report ─────────────────────────────────────────────────────────────────── + +if (@errors) { + print STDERR "CORE_SMOKE_ERRORS:\n"; + print STDERR " $_\n" for @errors; + exit 1; +} + +print "CORE_SMOKE_OK\n"; +if (@skipped) { + print "CORE_SMOKE_SKIPPED: ", join(', ', @skipped), "\n"; +} diff --git a/tests/smoke/lib/Core/TestMod.pm b/tests/smoke/lib/Core/TestMod.pm new file mode 100644 index 0000000..1fd43dc --- /dev/null +++ b/tests/smoke/lib/Core/TestMod.pm @@ -0,0 +1,139 @@ +package Core::TestMod; +use strict; +use warnings; + +sub run { + my @errors; + my @skipped; + + # ── Tier 1: universal core ──────────────────────────────────────────────── + + # Digest::MD5 (XS, core since 5.8) + eval { + require Digest::MD5; + my $md5 = Digest::MD5::md5_hex('zeroperl'); + die "Digest::MD5" unless length($md5) == 32; + 1; + } or push @errors, "Digest::MD5: $@"; + + # List::Util (XS, core since 5.8) + eval { + require List::Util; + my $sum = List::Util::sum(1, 2, 3, 4, 5); + die "List::Util::sum" unless $sum == 15; + 1; + } or push @errors, "List::Util: $@"; + + # Cwd (XS, core since 5.4) + eval { + require Cwd; + my $cwd = Cwd::getcwd(); + die "Cwd::getcwd" unless defined $cwd && length($cwd) > 0; + 1; + } or push @errors, "Cwd: $@"; + + # Fcntl (XS, core since 5.4) + eval { + require Fcntl; + my $ok = defined &Fcntl::O_RDONLY; + die "Fcntl::O_RDONLY" unless $ok; + 1; + } or push @errors, "Fcntl: $@"; + + # MIME::Base64 (XS, core since 5.8) + eval { + require MIME::Base64; + my $enc = MIME::Base64::encode_base64('hello'); + my $dec = MIME::Base64::decode_base64($enc); + die "MIME::Base64 roundtrip" unless $dec eq 'hello'; + 1; + } or push @errors, "MIME::Base64: $@"; + + # Basic regex and string ops (core language, no module needed) + eval { + my $s = "Hello, World!"; + die "regex match" unless $s =~ /World/; + my $r = $s =~ s/World/Perl/r; + die "regex subst" unless $r eq "Hello, Perl!"; + die "split/join" unless join(':', split(/,/, "a,b,c")) eq "a:b:c"; + 1; + } or push @errors, "regex/string: $@"; + + # ── Tier 2: version-conditional ─────────────────────────────────────────── + + # File::Spec — core since 5.5, but may be stripped by wasm-opt in full-shrink + # builds or missing from the embedded SFS. + eval { + require File::Spec; + my $cat = File::Spec->catfile('a', 'b', 'c'); + die "File::Spec->catfile" unless $cat && $cat =~ m{a}; + 1; + } or do { + push @skipped, "File::Spec"; + }; + + # Data::Dumper — core since 5.6, but depends on constant.pm which depends on + # unicore/Heavy.pl (via utf8_heavy.pl) on Perl < 5.18. The unicore directory + # is trimmed from the prefix in some builds. + eval { + require Data::Dumper; + my $s = Data::Dumper::Dumper([1, 2, 3]); + die "Data::Dumper" unless $s && $s =~ /\d/; + 1; + } or do { + push @skipped, "Data::Dumper"; + }; + + # IO::File — core since 5.4, but new_tmpfile does not work in WASI (no tmpdir). + # Test file I/O via in-memory write/read on an explicit file path instead. + eval { + require IO::File; + my $fh = IO::File->new('/work/_smoke_tmp', 'w'); + die "IO::File->new(w)" unless $fh; + print $fh "test\n"; + $fh->close; + $fh = IO::File->new('/work/_smoke_tmp', 'r'); + die "IO::File->new(r)" unless $fh; + my $line = <$fh>; + $fh->close; + die "IO::File roundtrip" unless $line eq "test\n"; + 1; + } or do { + push @skipped, "IO::File"; + }; + + # Encode — core since 5.8, but depends on unicore/Heavy.pl on older perls. + eval { + require Encode; + my $enc = Encode::encode('UTF-8', 'hello'); + my $dec = Encode::decode('UTF-8', $enc); + die "Encode roundtrip" unless $dec eq 'hello'; + 1; + } or do { + push @skipped, "Encode"; + }; + + # File::Glob — core since 5.6, may be stripped or unavailable. + eval { + require File::Glob; + my @files = File::Glob::bsd_glob('*'); + die "File::Glob" unless @files >= 0; + 1; + } or do { + push @skipped, "File::Glob"; + }; + + # POSIX — not built in the WASI configuration (noextensions). + eval { + require POSIX; + my $ceil = POSIX::ceil(1.5); + die "POSIX::ceil" unless $ceil == 2; + 1; + } or do { + push @skipped, "POSIX"; + }; + + return (\@errors, \@skipped); +} + +1; diff --git a/tests/smoke/sample.jpg.b64 b/tests/smoke/sample.jpg.b64 new file mode 100644 index 0000000..7fe72f7 --- /dev/null +++ b/tests/smoke/sample.jpg.b64 @@ -0,0 +1,7 @@ +/9j/4AAQSkZJRgABAQAAAQABAAD/2wCEAAkGBxAQEBUQEA8QDw8PDw8QDw8QDw8QFREWFhUR +FRUYHSggGBolGxUVITEhJSkrLi4uFx8zODMtNygtLisBCgoKDg0OGxAQGi0lHyUtLS0tLS0t +LS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLf/AABEIAAEAAQMBIgAC +EQEDEQH/xAAXAAADAQAAAAAAAAAAAAAAAAAAAQID/8QAFhEBAQEAAAAAAAAAAAAAAAAAAAER +/9oADAMBAAIQAxAAAAH5AAf/xAAZEAEAAgMAAAAAAAAAAAAAAAABABEhMVH/2gAIAQEAAT8A +pmq0z//EABYRAQEBAAAAAAAAAAAAAAAAAAABEf/aAAgBAgEBPwCF/8QAFhEBAQEAAAAAAAAA +AAAAAAAAAAER/9oACAEDAQE/AYf/2Q== \ No newline at end of file diff --git a/tests/smoke/sample.tiff.b64 b/tests/smoke/sample.tiff.b64 new file mode 100644 index 0000000..4057a6a --- /dev/null +++ b/tests/smoke/sample.tiff.b64 @@ -0,0 +1,4 @@ +SUkqAAgAAAAJAAABBAABAAAAAQAAAAEBBAABAAAAAQAAAAIBAwADAAAAegAAAAMBAwABAAAA +AQAAAAYBAwABAAAAAgAAABEBBAABAAAAjAAAABUBAwABAAAAAwAAABYBBAABAAAAAQAAABcB +BAABAAAAAwAAABwBAwABAAAAAQAAAAAAAAAIAAgACAAAAAEAAAABAAABAAABAAABAAABAAEA +AAABAAABAAABAAABAAABAAABAAABAAABAAABAAABAAABAAABAAABAAABAAABAAAAAA== \ No newline at end of file diff --git a/tests/smoke/sample.xmp b/tests/smoke/sample.xmp new file mode 100644 index 0000000..d790fb2 --- /dev/null +++ b/tests/smoke/sample.xmp @@ -0,0 +1,10 @@ + + + + + + + diff --git a/tools/check-wasm-shrink-determinism.sh b/tools/check-wasm-shrink-determinism.sh new file mode 100755 index 0000000..5e553e3 --- /dev/null +++ b/tools/check-wasm-shrink-determinism.sh @@ -0,0 +1,62 @@ +#!/bin/sh +set -e + +REPO_DIR="${REPO_DIR:-$(CDPATH= cd -- "$(dirname "$0")/.." && pwd)}" +NATIVE_DIR="${NATIVE_DIR:-/build/native}" +ZEROPERL_SHRINK="${ZEROPERL_SHRINK:-full}" + +if [ "$ZEROPERL_SHRINK" = "off" ]; then + echo "determinism check skipped: ZEROPERL_SHRINK=off" + exit 0 +fi + +snapshot_file() { + src="$1" + dst="$2" + if [ -f "$src" ]; then + cp "$src" "$dst" + else + : > "$dst" + fi +} + +compare_file() { + left="$1" + right="$2" + label="$3" + if ! cmp -s "$left" "$right"; then + echo "error: non-deterministic output for $label" >&2 + diff -u "$left" "$right" || true + exit 1 + fi +} + +run_regen() { + REPO_DIR="$REPO_DIR" NATIVE_DIR="$NATIVE_DIR" ZEROPERL_SHRINK="$ZEROPERL_SHRINK" \ + "$REPO_DIR/tools/regen-wasm-shrink.sh" +} + +TMP_DIR="$(mktemp -d)" +trap 'rm -rf "$TMP_DIR"' EXIT INT TERM + +run_regen +snapshot_file "$REPO_DIR/gen/traced-files.txt" "$TMP_DIR/traced-files.a" +snapshot_file "$REPO_DIR/gen/xs-static-ext.txt" "$TMP_DIR/xs-static-ext.a" +snapshot_file "$REPO_DIR/gen/hints-static-ext.fragment" "$TMP_DIR/hints-static-ext.a" +snapshot_file "$REPO_DIR/gen/wasm-auto-libs.txt" "$TMP_DIR/wasm-auto-libs.a" +snapshot_file "$REPO_DIR/gen/xs_init.inc" "$TMP_DIR/xs-init.a" + +run_regen +snapshot_file "$REPO_DIR/gen/traced-files.txt" "$TMP_DIR/traced-files.b" +snapshot_file "$REPO_DIR/gen/xs-static-ext.txt" "$TMP_DIR/xs-static-ext.b" +snapshot_file "$REPO_DIR/gen/hints-static-ext.fragment" "$TMP_DIR/hints-static-ext.b" +snapshot_file "$REPO_DIR/gen/wasm-auto-libs.txt" "$TMP_DIR/wasm-auto-libs.b" +snapshot_file "$REPO_DIR/gen/xs_init.inc" "$TMP_DIR/xs-init.b" + +compare_file "$TMP_DIR/traced-files.a" "$TMP_DIR/traced-files.b" "gen/traced-files.txt" +compare_file "$TMP_DIR/xs-static-ext.a" "$TMP_DIR/xs-static-ext.b" "gen/xs-static-ext.txt" +compare_file "$TMP_DIR/hints-static-ext.a" "$TMP_DIR/hints-static-ext.b" "gen/hints-static-ext.fragment" +compare_file "$TMP_DIR/wasm-auto-libs.a" "$TMP_DIR/wasm-auto-libs.b" "gen/wasm-auto-libs.txt" +compare_file "$TMP_DIR/xs-init.a" "$TMP_DIR/xs-init.b" "gen/xs_init.inc" + +echo "determinism check passed" diff --git a/tools/delete.js b/tools/delete.js index 1931f1a..963ce79 100644 --- a/tools/delete.js +++ b/tools/delete.js @@ -17,10 +17,10 @@ const path = require("path"); // Get the log file, base directory, and Perl version from command-line arguments const args = process.argv.slice(2); if (args.length < 3) { - console.error( - "Usage: delete.js ", - ); - process.exit(1); + console.error( + "Usage: delete.js ", + ); + process.exit(1); } const logFilePath = path.resolve(args[0]); @@ -30,41 +30,41 @@ const perlVersion = args[2]; // Read the log file synchronously let content; try { - content = fs.readFileSync(logFilePath, "utf8"); + content = fs.readFileSync(logFilePath, "utf8"); } catch (err) { - console.error(`Error reading file ${logFilePath}:`, err.message); - process.exit(1); + console.error(`Error reading file ${logFilePath}:`, err.message); + process.exit(1); } // Split the content into lines, trim whitespace, and remove empty lines. const entries = content - .split(/\r?\n/) - .map((line) => line.trim()) - .filter((line) => line.length > 0) - .map((line) => line.replace(/{VERSION}/g, perlVersion)); // Replace {VERSION} with actual version + .split(/\r?\n/) + .map((line) => line.trim()) + .filter((line) => line.length > 0) + .map((line) => line.replace(/{VERSION}/g, perlVersion)); // Replace {VERSION} with actual version // Reverse the array so that nested files/directories are processed first. entries.reverse(); // Process each entry synchronously. for (const relativeEntry of entries) { - // The target file/directory is located at baseDir/relativeEntry - const targetPath = path.resolve(baseDir, relativeEntry); + // The target file/directory is located at baseDir/relativeEntry + const targetPath = path.resolve(baseDir, relativeEntry); - try { - const stat = fs.lstatSync(targetPath); - if (stat.isDirectory()) { - // Remove the directory (recursively) - fs.rmdirSync(targetPath, { recursive: true }); - console.log(`Deleted directory: ${relativeEntry}`); - } else { - // Remove a file or symbolic link - fs.unlinkSync(targetPath); - console.log(`Deleted file: ${relativeEntry}`); - } - } catch (err) { - console.error(`Error deleting "${relativeEntry}":`, err.message); - } + try { + const stat = fs.lstatSync(targetPath); + if (stat.isDirectory()) { + // Remove the directory (recursively) + fs.rmSync(targetPath, { recursive: true }); + console.log(`Deleted directory: ${relativeEntry}`); + } else { + // Remove a file or symbolic link + fs.unlinkSync(targetPath); + console.log(`Deleted file: ${relativeEntry}`); + } + } catch (err) { + console.error(`Error deleting "${relativeEntry}":`, err.message); + } } console.log("\nDeletion complete!"); diff --git a/tools/emit-wasm-xs-bundle.pl b/tools/emit-wasm-xs-bundle.pl new file mode 100644 index 0000000..7251ba8 --- /dev/null +++ b/tools/emit-wasm-xs-bundle.pl @@ -0,0 +1,140 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use File::Find qw(find); +use File::Path qw(make_path); +use File::Basename qw(dirname); +use Getopt::Long qw(GetOptions); + +my $native_prefix; +my $static_ext_file; +my $baseline_file; +my $hints_out; +my $libs_out; +my $xs_init_out; + +GetOptions( + 'native-prefix=s' => \$native_prefix, + 'static-ext-file=s' => \$static_ext_file, + 'baseline-file=s' => \$baseline_file, + 'hints-out=s' => \$hints_out, + 'libs-out=s' => \$libs_out, + 'xs-init-out=s' => \$xs_init_out, +) or die "bad options\n"; + +die "--native-prefix required\n" unless defined $native_prefix; +die "--static-ext-file required\n" unless defined $static_ext_file; +die "--baseline-file required\n" unless defined $baseline_file; +die "--hints-out required\n" unless defined $hints_out; +die "--libs-out required\n" unless defined $libs_out; +die "--xs-init-out required\n" unless defined $xs_init_out; + +sub read_lines { + my ($path) = @_; + open my $fh, '<', $path or die "open $path: $!"; + my @lines; + while (my $line = <$fh>) { + chomp $line; + $line =~ s/\s+#.*$//; + next if $line =~ /^\s*$/; + push @lines, $line; + } + close $fh; + return @lines; +} + +my %wanted; +$wanted{$_} = 1 for read_lines($baseline_file), read_lines($static_ext_file); +my @exts = sort keys %wanted; + +my (%archive_for, %has_boot_symbol, %has_archive); +find( + sub { + return unless /\.a$/; + my $archive = $File::Find::name; + for my $ext (@exts) { + if ($archive =~ m{/auto/\Q$ext\E/([^/]+\.a)$}) { + $archive_for{$ext} //= $archive; + $has_archive{$ext} = 1; + } + } + }, + $native_prefix, +); + +my %known_no_boot = map { $_ => 1 } qw(mro); +my @boot_exts = ('DynaLoader'); + +sub archive_has_symbol { + my ($archive, $symbol) = @_; + for my $cmd ('llvm-nm -g', 'nm -g') { + my $output = qx{$cmd "$archive" 2>/dev/null}; + next if $? != 0; + return 1 if $output =~ /\b\Q$symbol\E\b/; + } + return 0; +} + +for my $ext (@exts) { + if ($has_archive{$ext}) { + my $boot_symbol = ext_to_boot_symbol($ext); + if (archive_has_symbol($archive_for{$ext}, $boot_symbol)) { + push @boot_exts, $ext; + $has_boot_symbol{$ext} = 1; + next; + } + next if $known_no_boot{$ext}; + die "traced XS extension '$ext' archive '$archive_for{$ext}' is missing expected bootstrap symbol '$boot_symbol'\n"; + next; + } + next if $known_no_boot{$ext}; + die "traced XS extension '$ext' has no native static archive or known-no-boot mapping\n"; +} + +for my $path ($hints_out, $libs_out, $xs_init_out) { + my $dir = dirname($path); + make_path($dir) if defined $dir && length $dir && !-d $dir; +} + +open my $hints_fh, '>', $hints_out or die "open $hints_out: $!"; +print {$hints_fh} "\nstatic_ext='", join(' ', @exts), "'\n"; +close $hints_fh; + +open my $libs_fh, '>', $libs_out or die "open $libs_out: $!"; +for my $ext (sort grep { $archive_for{$_} } keys %archive_for) { + my $archive = $archive_for{$ext}; + $archive =~ s{^.*?/auto/}{lib/auto/}; + print {$libs_fh} "$archive\n"; +} +close $libs_fh; + +sub ext_to_boot_symbol { + my ($ext) = @_; + return 'boot_DynaLoader' if $ext eq 'DynaLoader'; + (my $symbol = $ext) =~ s{/}{__}g; + return "boot_$symbol"; +} + +sub ext_to_boot_name { + my ($ext) = @_; + return 'DynaLoader::boot_DynaLoader' if $ext eq 'DynaLoader'; + (my $name = $ext) =~ s{/}{::}g; + return "$name\::bootstrap"; +} + +open my $xs_fh, '>', $xs_init_out or die "open $xs_init_out: $!"; +for my $ext (@boot_exts) { + print {$xs_fh} "EXTERN_C void ", ext_to_boot_symbol($ext), "(pTHX_ CV *cv);\n"; +} +print {$xs_fh} "\n"; +print {$xs_fh} "static void xs_init(pTHX) {\n"; +print {$xs_fh} " static const char file[] = __FILE__;\n"; +print {$xs_fh} " dXSUB_SYS;\n"; +print {$xs_fh} " PERL_UNUSED_CONTEXT;\n\n"; +for my $ext (@boot_exts) { + print {$xs_fh} ' newXS("', ext_to_boot_name($ext), '", ', + ext_to_boot_symbol($ext), ", file);\n"; +} +print {$xs_fh} "}\n"; +close $xs_fh; diff --git a/tools/extract-missing-paths.pl b/tools/extract-missing-paths.pl new file mode 100644 index 0000000..bb7b57a --- /dev/null +++ b/tools/extract-missing-paths.pl @@ -0,0 +1,25 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +my $log = shift @ARGV or die "usage: $0 [output]\n"; +my $out = shift @ARGV; + +open my $fh, '<', $log or die "open $log: $!"; +my %seen; +while (my $line = <$fh>) { + while ($line =~ /Can't locate ([A-Za-z0-9_\/.-]+\.(?:pm|pl))/g) { + $seen{$1} = 1; + } +} +close $fh; + +my @paths = sort keys %seen; +if (defined $out) { + open my $ofh, '>', $out or die "open $out: $!"; + print {$ofh} "$_\n" for @paths; + close $ofh; +} +else { + print "$_\n" for @paths; +} diff --git a/tools/file-glob-shim.pm b/tools/file-glob-shim.pm new file mode 100644 index 0000000..6ea79ab --- /dev/null +++ b/tools/file-glob-shim.pm @@ -0,0 +1,71 @@ +package File::Glob; + +use strict; + +our ($DEFAULT_FLAGS); + +require XSLoader; + +our %EXPORT_TAGS = ( + glob => [qw( + GLOB_ABEND + GLOB_ALPHASORT + GLOB_ALTDIRFUNC + GLOB_BRACE + GLOB_CSH + GLOB_ERR + GLOB_ERROR + GLOB_LIMIT + GLOB_MARK + GLOB_NOCASE + GLOB_NOCHECK + GLOB_NOMAGIC + GLOB_NOSORT + GLOB_NOSPACE + GLOB_QUOTE + GLOB_TILDE + bsd_glob + )], +); +$EXPORT_TAGS{bsd_glob} = [@{$EXPORT_TAGS{glob}}]; + +our @EXPORT_OK = (@{$EXPORT_TAGS{glob}}, "csh_glob"); +# Note: $VERSION intentionally omitted so XSLoader::load() skips the +# version check. The compiled File::Glob XS version varies by Perl +# branch (1.17 for 5.16, 1.28 for 5.26, 1.42 for 5.42, etc.). + +sub import { + require Exporter; + local $Exporter::ExportLevel = $Exporter::ExportLevel + 1; + Exporter::import(grep { + my $passthrough; + if ($_ eq ":case") { + $DEFAULT_FLAGS &= ~GLOB_NOCASE(); + } + elsif ($_ eq ":nocase") { + $DEFAULT_FLAGS |= GLOB_NOCASE(); + } + elsif ($_ eq ":globally") { + no warnings "redefine"; + *CORE::GLOBAL::glob = \&File::Glob::csh_glob; + } + elsif ($_ eq ":bsd_glob") { + no strict "refs"; + *{caller . "::glob"} = \&bsd_glob_override; + $passthrough = 1; + } + else { + $passthrough = 1; + } + $passthrough; + } @_); +} + +XSLoader::load(); + +$DEFAULT_FLAGS = GLOB_CSH(); +if ($^O =~ /^(?:MSWin32|VMS|os2|riscos)$/) { + $DEFAULT_FLAGS |= GLOB_NOCASE(); +} + +1; diff --git a/tools/package-lock.json b/tools/package-lock.json new file mode 100644 index 0000000..74147f8 --- /dev/null +++ b/tools/package-lock.json @@ -0,0 +1,130 @@ +{ + "name": "tools", + "lockfileVersion": 3, + "requires": true, + "packages": { + "": { + "dependencies": { + "lz4": "^0.6.5" + }, + "devDependencies": { + "@6over3/zeroperl-ts": "file:../zeroperl-ts" + } + }, + "../zeroperl-ts": { + "name": "@6over3/zeroperl-ts", + "version": "1.0.10", + "dev": true, + "license": "Apache-2.0", + "devDependencies": { + "@types/bun": "^1.3.2", + "typescript": "^5.7.3" + } + }, + "node_modules/@6over3/zeroperl-ts": { + "resolved": "../zeroperl-ts", + "link": true + }, + "node_modules/base64-js": { + "version": "1.5.1", + "resolved": "https://registry.npmjs.org/base64-js/-/base64-js-1.5.1.tgz", + "integrity": "sha512-AKpaYlHn8t4SVbOHCy+b5+KKgvR4vrsD8vbvrbiQJps7fKDTkjkDry6ji0rUJjC0kzbNePLwzxq8iypo41qeWA==", + "funding": [ + { + "type": "github", + "url": "https://github.com/sponsors/feross" + }, + { + "type": "patreon", + "url": "https://www.patreon.com/feross" + }, + { + "type": "consulting", + "url": "https://feross.org/support" + } + ], + "license": "MIT" + }, + "node_modules/buffer": { + "version": "5.7.1", + "resolved": "https://registry.npmjs.org/buffer/-/buffer-5.7.1.tgz", + "integrity": "sha512-EHcyIPBQ4BSGlvjB16k5KgAJ27CIsHY/2JBmCRReo48y9rQ3MaUzWX3KVlBa4U7MyX02HdVj0K7C3WaB3ju7FQ==", + "funding": [ + { + "type": "github", + "url": "https://github.com/sponsors/feross" + }, + { + "type": "patreon", + "url": "https://www.patreon.com/feross" + }, + { + "type": "consulting", + "url": "https://feross.org/support" + } + ], + "license": "MIT", + "dependencies": { + "base64-js": "^1.3.1", + "ieee754": "^1.1.13" + } + }, + "node_modules/cuint": { + "version": "0.2.2", + "resolved": "https://registry.npmjs.org/cuint/-/cuint-0.2.2.tgz", + "integrity": "sha512-d4ZVpCW31eWwCMe1YT3ur7mUDnTXbgwyzaL320DrcRT45rfjYxkt5QWLrmOJ+/UEAI2+fQgKe/fCjR8l4TpRgw==", + "license": "MIT" + }, + "node_modules/ieee754": { + "version": "1.2.1", + "resolved": "https://registry.npmjs.org/ieee754/-/ieee754-1.2.1.tgz", + "integrity": "sha512-dcyqhDvX1C46lXZcVqCpK+FtMRQVdIMN6/Df5js2zouUsqG7I6sFxitIC+7KYK29KdXOLHdu9zL4sFnoVQnqaA==", + "funding": [ + { + "type": "github", + "url": "https://github.com/sponsors/feross" + }, + { + "type": "patreon", + "url": "https://www.patreon.com/feross" + }, + { + "type": "consulting", + "url": "https://feross.org/support" + } + ], + "license": "BSD-3-Clause" + }, + "node_modules/lz4": { + "version": "0.6.5", + "resolved": "https://registry.npmjs.org/lz4/-/lz4-0.6.5.tgz", + "integrity": "sha512-KSZcJU49QZOlJSItaeIU3p8WoAvkTmD9fJqeahQXNu1iQ/kR0/mQLdbrK8JY9MY8f6AhJoMrihp1nu1xDbscSQ==", + "hasInstallScript": true, + "license": "MIT", + "dependencies": { + "buffer": "^5.2.1", + "cuint": "^0.2.2", + "nan": "^2.13.2", + "xxhashjs": "^0.2.2" + }, + "engines": { + "node": ">= 0.10" + } + }, + "node_modules/nan": { + "version": "2.26.2", + "resolved": "https://registry.npmjs.org/nan/-/nan-2.26.2.tgz", + "integrity": "sha512-0tTvBTYkt3tdGw22nrAy50x7gpbGCCFH3AFcyS5WiUu7Eu4vWlri1woE6qHBSfy11vksDqkiwjOnlR7WV8G1Hw==", + "license": "MIT" + }, + "node_modules/xxhashjs": { + "version": "0.2.2", + "resolved": "https://registry.npmjs.org/xxhashjs/-/xxhashjs-0.2.2.tgz", + "integrity": "sha512-AkTuIuVTET12tpsVIQo+ZU6f/qDmKuRUcjaqR+OIvm+aCBsZ95i7UVY5WJ9TMsSaZ0DA2WxoZ4acu0sPH+OKAw==", + "license": "MIT", + "dependencies": { + "cuint": "^0.2.2" + } + } + } +} diff --git a/tools/package.json b/tools/package.json new file mode 100644 index 0000000..f306168 --- /dev/null +++ b/tools/package.json @@ -0,0 +1,11 @@ +{ + "dependencies": { + "lz4": "^0.6.5" + }, + "scripts": { + "verify:embedded-inc": "node verify-embedded-inc.mjs" + }, + "devDependencies": { + "@6over3/zeroperl-ts": "file:../zeroperl-ts" + } +} diff --git a/tools/perltidy-skip.txt b/tools/perltidy-skip.txt new file mode 100644 index 0000000..af97d6f --- /dev/null +++ b/tools/perltidy-skip.txt @@ -0,0 +1,5 @@ +# Files to skip during perltidy trimming. +# Patterns are matched against paths relative to /zeroperl/ using shell glob syntax. + +# Generated by miniperl during build; contains binary-ish data +*/buildcustomize.pl diff --git a/tools/regen-wasm-shrink.sh b/tools/regen-wasm-shrink.sh new file mode 100755 index 0000000..4084bff --- /dev/null +++ b/tools/regen-wasm-shrink.sh @@ -0,0 +1,112 @@ +#!/bin/sh +set -e + +REPO_DIR="${REPO_DIR:-$(CDPATH= cd -- "$(dirname "$0")/.." && pwd)}" +NATIVE_DIR="${NATIVE_DIR:-/build/native}" +PERL_VERSION="${PERL_VERSION:-5.42.2}" + +ENV_FILE="$REPO_DIR/tools/wasm-shrink.env" +[ -f "$ENV_FILE" ] && . "$ENV_FILE" +ZEROPERL_SHRINK="${ZEROPERL_SHRINK:-off}" +# TRACE_ENTRY_SCRIPT="${TRACE_ENTRY_SCRIPT:-exiftool.min.pl}" +# TRACE_USE_MODULE="${TRACE_USE_MODULE:-Image::ExifTool}" +BUILD_EXIFTOOL="${BUILD_EXIFTOOL:-false}" +if [ "$BUILD_EXIFTOOL" = "true" ]; then + TRACE_ENTRY_SCRIPT="${TRACE_ENTRY_SCRIPT:-exiftool.min.pl}" + TRACE_USE_MODULE="${TRACE_USE_MODULE:-Image::ExifTool}" +else + TRACE_ENTRY_SCRIPT="${TRACE_ENTRY_SCRIPT:-}" + TRACE_USE_MODULE="${TRACE_USE_MODULE:-}" +fi +TRACE_EXPLICIT_PACKAGES="${TRACE_EXPLICIT_PACKAGES:-}" +TRACE_ALLOWLIST="${TRACE_ALLOWLIST:-gen/extra-paths-allowlist.txt}" +TRACE_WARMUP_INC="${TRACE_WARMUP_INC:-gen/warmup-inc.txt}" +TRACE_MISSING_REPORT="${TRACE_MISSING_REPORT:-gen/wasm-missing-paths.txt}" +TRACE_ENTRY_ARGS="${TRACE_ENTRY_ARGS:--ver}" +TRACE_EXPAND_EXPLICIT_PACKAGE_TREES="${TRACE_EXPAND_EXPLICIT_PACKAGE_TREES:-true}" +TRACE_EXPAND_DEPENDENCY_PACKAGE_TREES="${TRACE_EXPAND_DEPENDENCY_PACKAGE_TREES:-true}" +EXIFTOOL_WARMUP_MODE="${EXIFTOOL_WARMUP_MODE:-curated}" + +export EXIFTOOL_WARMUP_MODE + +mkdir -p "$REPO_DIR/gen" +[ -f "$REPO_DIR/${TRACE_ALLOWLIST}" ] || : > "$REPO_DIR/${TRACE_ALLOWLIST}" +[ -f "$REPO_DIR/${TRACE_WARMUP_INC}" ] || : > "$REPO_DIR/${TRACE_WARMUP_INC}" +[ -f "$REPO_DIR/${TRACE_MISSING_REPORT}" ] || : > "$REPO_DIR/${TRACE_MISSING_REPORT}" + +if [ "$ZEROPERL_SHRINK" = "off" ]; then + exit 0 +fi + +SITE_PERL_ROOT="$NATIVE_DIR/prefix/lib/perl5/site_perl/$PERL_VERSION" +ENTRY_SCRIPT="$REPO_DIR/$TRACE_ENTRY_SCRIPT" + +#set -- perl "$REPO_DIR/tools/trace-zeroperl-deps.pl" \ +set -- "$NATIVE_DIR/prefix/bin/perl" "$REPO_DIR/tools/trace-zeroperl-deps.pl" \ + --native-prefix "$NATIVE_DIR/prefix" \ + --perl-version "$PERL_VERSION" \ + --site-perl-root "$SITE_PERL_ROOT" \ + --output "$REPO_DIR/gen/traced-files.txt" \ + --xs-output "$REPO_DIR/gen/xs-static-ext.txt" \ + --allowlist "$REPO_DIR/$TRACE_ALLOWLIST" \ + --warmup-file "$REPO_DIR/$TRACE_WARMUP_INC" \ + --entry-arg "$TRACE_ENTRY_ARGS" \ + --entry-script "$ENTRY_SCRIPT" + +for module in $(printf '%s' "$TRACE_USE_MODULE" | tr ',' ' '); do + [ -n "$module" ] || continue + set -- "$@" --use "$module" +done + +for module in $(printf '%s' "$TRACE_EXPLICIT_PACKAGES" | tr ',' ' '); do + [ -n "$module" ] || continue + set -- "$@" --explicit-package "$module" +done + +if [ "$TRACE_EXPAND_EXPLICIT_PACKAGE_TREES" = "true" ]; then + set -- "$@" --expand-explicit-package-trees +else + set -- "$@" --no-expand-explicit-package-trees +fi + +if [ "$TRACE_EXPAND_DEPENDENCY_PACKAGE_TREES" = "true" ]; then + set -- "$@" --expand-dependency-package-trees +else + set -- "$@" --no-expand-dependency-package-trees +fi + +"$@" + +if [ ! -s "$REPO_DIR/gen/traced-files.txt" ]; then + echo "error: expected non-empty traced file output" >&2 + exit 1 +fi + +if [ "$ZEROPERL_SHRINK" = "full" ]; then + # Filter baseline to only include extensions that have native archives + FILTERED_BASELINE=$(mktemp) + while IFS= read -r ext; do + [ -n "$ext" ] || continue + if find "$NATIVE_DIR/prefix" -path "*/auto/$ext/*.a" 2>/dev/null | grep -q .; then + echo "$ext" >> "$FILTERED_BASELINE" + else + echo "note: skipping $ext from baseline (no native archive for $PERL_VERSION)" + fi + done < "$REPO_DIR/tools/wasm-xs-kernel.txt" + + perl "$REPO_DIR/tools/emit-wasm-xs-bundle.pl" \ + --native-prefix "$NATIVE_DIR/prefix" \ + --static-ext-file "$REPO_DIR/gen/xs-static-ext.txt" \ + --baseline-file "$FILTERED_BASELINE" \ + --hints-out "$REPO_DIR/gen/hints-static-ext.fragment" \ + --libs-out "$REPO_DIR/gen/wasm-auto-libs.txt" \ + --xs-init-out "$REPO_DIR/gen/xs_init.inc" + rm -f "$FILTERED_BASELINE" + + if [ ! -s "$REPO_DIR/gen/hints-static-ext.fragment" ] || \ + [ ! -s "$REPO_DIR/gen/wasm-auto-libs.txt" ] || \ + [ ! -s "$REPO_DIR/gen/xs_init.inc" ]; then + echo "error: expected non-empty full shrink outputs (hints/libs/xs_init)" >&2 + exit 1 + fi +fi diff --git a/tools/sfs.js b/tools/sfs.js index c09dc82..510f646 100644 --- a/tools/sfs.js +++ b/tools/sfs.js @@ -1,75 +1,141 @@ #!/usr/bin/env node -const fs = require('node:fs'); -const path = require('node:path'); +"use strict"; -const args = process.argv.slice(2); -let inputPath = ''; -let outputPath = ''; -let prefix = ''; -let skipRegex = ''; +const fs = require("node:fs"); +const path = require("node:path"); +const lz4 = require("lz4"); function usage() { - console.error(`Usage: sfs.js -i -o
[--prefix ] [--skip ]`); - process.exit(1); + console.error( + `Usage: sfs.js -o
[--prefix ] [--skip ] [--compress] [--empty]`, + ); + console.error( + ` sfs.js -i -o
[--prefix ] [--skip ] [--compress]`, + ); + process.exit(1); } -for (let i = 0; i < args.length; i++) { +function parseArgs(args) { + let inputPath = ""; + let outputPath = ""; + let prefix = ""; + let skipRegex = ""; + let compress = false; + let empty = false; + + for (let i = 0; i < args.length; i++) { const arg = args[i]; - if (arg === '-i' || arg === '--input-path') inputPath = args[++i]; - else if (arg === '-o' || arg === '--output-path') outputPath = args[++i]; - else if (arg === '--prefix') prefix = args[++i]; - else if (arg === '--skip') skipRegex = args[++i]; - else if (arg.startsWith('--')) { - const [key, val] = arg.slice(2).split('='); - if (key === 'input-path') inputPath = val; - else if (key === 'output-path') outputPath = val; - else if (key === 'prefix') prefix = val; - else if (key === 'skip') skipRegex = val; - else usage(); - } else usage(); + if (arg === "-i" || arg === "--input-path") inputPath = args[++i]; + else if (arg === "-o" || arg === "--output-path") outputPath = args[++i]; + else if (arg === "--prefix") prefix = args[++i]; + else if (arg === "--skip") skipRegex = args[++i]; + else if (arg === "--compress") compress = true; + else if (arg === "--empty") empty = true; + else if (arg.startsWith("--")) { + const [key, val] = arg.slice(2).split("="); + if (key === "input-path") inputPath = val; + else if (key === "output-path") outputPath = val; + else if (key === "prefix") prefix = val; + else if (key === "skip") skipRegex = val; + else if (key === "compress") { + compress = true; + } else if (key === "empty") { + empty = true; + } else usage(); + } else { + usage(); + } + } + + if (!outputPath) usage(); + + if (!empty) { + if (!inputPath) usage(); + inputPath = path.resolve(inputPath); + if (!fs.existsSync(inputPath) || !fs.statSync(inputPath).isDirectory()) { + console.error("Input path does not exist or is not a directory"); + process.exit(1); + } + } + + return { inputPath, outputPath, prefix, skipRegex, compress, empty }; } -if (!inputPath || !outputPath) usage(); +function collectInputFiles(inputPath, skipRegex) { + const relpaths = []; + const rawDatas = []; + const skipPattern = skipRegex ? new RegExp(skipRegex) : null; + + function traverse(dir) { + for (const entry of fs.readdirSync(dir).sort()) { + if (entry.startsWith(".")) continue; + const fullPath = path.join(dir, entry); + const stat = fs.statSync(fullPath); + const rel = path.relative(inputPath, fullPath); + if (skipPattern && skipPattern.test(rel)) continue; + if (stat.isDirectory()) { + traverse(fullPath); + } else if (stat.isFile()) { + relpaths.push(rel.split(path.sep).join("/")); + rawDatas.push(fs.readFileSync(fullPath)); + } + } + } + + traverse(inputPath); + return { relpaths, rawDatas }; +} -inputPath = path.resolve(inputPath); -if (!fs.existsSync(inputPath) || !fs.statSync(inputPath).isDirectory()) { - console.error("Input path does not exist or is not a directory"); - process.exit(1); +function compressLz4Frame(raw) { + return lz4.encode(raw); } -const relpaths = []; -const fileDatas = []; - -function traverse(dir) { - for (const entry of fs.readdirSync(dir)) { - if (entry.startsWith('.')) continue; - const fullPath = path.join(dir, entry); - const stat = fs.statSync(fullPath); - const rel = path.relative(inputPath, fullPath); - if (skipRegex && new RegExp(skipRegex).test(rel)) continue; - if (stat.isDirectory()) traverse(fullPath); - else if (stat.isFile()) { - relpaths.push(rel.split(path.sep).join('/')); - fileDatas.push(fs.readFileSync(fullPath)); - } +function buildFileData(rawDatas, compress) { + const fileDatas = []; + const decompressedSizes = []; + const codecs = []; + + if (compress) { + for (const raw of rawDatas) { + const compBuf = compressLz4Frame(raw); + fileDatas.push(compBuf); + decompressedSizes.push(raw.length); + codecs.push(1); } + } else { + for (const raw of rawDatas) { + fileDatas.push(raw); + decompressedSizes.push(0); + codecs.push(0); + } + } + + return { fileDatas, decompressedSizes, codecs }; } -traverse(inputPath); -const offsets = []; -let totalSize = 0; -for (const data of fileDatas) { +function buildOutputArtifacts( + relpaths, + fileDatas, + decompressedSizes, + codecs, + prefix, + outputPath, +) { + const offsets = []; + let totalSize = 0; + for (const data of fileDatas) { offsets.push(totalSize); totalSize += data.length; -} + } -const allData = Buffer.concat(fileDatas, totalSize); + const allData = Buffer.concat(fileDatas, totalSize); -const header = `#ifndef SFS_H + const header = `#ifndef SFS_H #define SFS_H #include +#include #define SFS_BUILTIN_PREFIX "${prefix}" @@ -77,6 +143,8 @@ struct sfs_entry { const char *abspath; const unsigned char *start; const unsigned char *end; + uint32_t decompressed_size; + uint8_t codec; }; extern size_t sfs_builtin_files_num; @@ -85,19 +153,15 @@ extern const struct sfs_entry sfs_entries[]; #endif `; -fs.writeFileSync(outputPath, header); -console.log(`Wrote header: ${outputPath}`); - -const binPath = outputPath.replace(/(\.h)?$/, '_data.bin'); -fs.writeFileSync(binPath, allData); -console.log(`Wrote binary: ${binPath} (${allData.length} bytes)`); - -const entries = relpaths.map((rel, i) => { - const vpath = prefix ? path.posix.join(prefix, rel) : rel; - return ` { "${vpath.replace(/"/g, '\\"')}", sfs_builtin_data + ${offsets[i]}, sfs_builtin_data + ${offsets[i]} + ${fileDatas[i].length} },`; -}).join('\n'); + const binPath = outputPath.replace(/(\.h)?$/, "_data.bin"); + const entries = relpaths + .map((rel, i) => { + const vpath = prefix ? path.posix.join(prefix, rel) : rel; + return ` { "${vpath.replace(/"/g, '\\"')}", sfs_builtin_data + ${offsets[i]}, sfs_builtin_data + ${offsets[i]} + ${fileDatas[i].length}, ${decompressedSizes[i]}, ${codecs[i]} },`; + }) + .join("\n"); -const dataC = `#include "${path.basename(outputPath)}" + const dataC = `#include "${path.basename(outputPath)}" size_t sfs_builtin_files_num = ${fileDatas.length}; @@ -110,6 +174,73 @@ ${entries} }; `; -const dataPath = outputPath.replace(/(\.h)?$/, '_data.c'); -fs.writeFileSync(dataPath, dataC); -console.log(`Wrote source: ${dataPath}`); + return { + header, + binPath, + allData, + dataC, + dataPath: outputPath.replace(/(\.h)?$/, "_data.c"), + }; +} + +function writeArtifacts(outputPath, artifacts) { + fs.writeFileSync(outputPath, artifacts.header); + console.log(`Wrote header: ${outputPath}`); + + fs.writeFileSync(artifacts.binPath, artifacts.allData); + console.log( + `Wrote binary: ${artifacts.binPath} (${artifacts.allData.length} bytes)`, + ); + + fs.writeFileSync(artifacts.dataPath, artifacts.dataC); + console.log(`Wrote source: ${artifacts.dataPath}`); +} + +function generateSfs(options) { + if (options.empty) { + const artifacts = buildOutputArtifacts( + [], + [], + [], + [], + options.prefix, + options.outputPath, + ); + writeArtifacts(options.outputPath, artifacts); + return artifacts; + } + const { relpaths, rawDatas } = collectInputFiles( + options.inputPath, + options.skipRegex, + ); + const { fileDatas, decompressedSizes, codecs } = buildFileData( + rawDatas, + options.compress, + ); + const artifacts = buildOutputArtifacts( + relpaths, + fileDatas, + decompressedSizes, + codecs, + options.prefix, + options.outputPath, + ); + writeArtifacts(options.outputPath, artifacts); + return artifacts; +} + +function main(argv) { + generateSfs(parseArgs(argv)); +} + +if (require.main === module) { + main(process.argv.slice(2)); +} + +module.exports = { + buildFileData, + collectInputFiles, + compressLz4Frame, + generateSfs, + parseArgs, +}; diff --git a/tools/trace-zeroperl-deps.pl b/tools/trace-zeroperl-deps.pl new file mode 100644 index 0000000..6dd0533 --- /dev/null +++ b/tools/trace-zeroperl-deps.pl @@ -0,0 +1,474 @@ +#!/usr/bin/env perl +use strict; +use warnings; +no warnings 'once'; + +use Config (); +use File::Find qw(find); +use File::Path qw(make_path); +use File::Spec; +use File::Basename qw(dirname); +use Getopt::Long qw(GetOptions); +use Module::ScanDeps (); + +# Call the main subroutine with command line arguments +exit( main(@ARGV) ); + +sub main { + my $opt = getoptions(); + + my @trace_inc = grep { -d $_ } ( + $opt->{site_perl_root}, + File::Spec->catdir( $opt->{site_perl_root}, $^O ), + File::Spec->catdir( + $opt->{site_perl_root}, + $Config::Config{archname} || () + ), + ); + + my $traced_relpaths = {}; + my $traced_modules = {}; + + my @hook_dirs = @trace_inc; + unshift @INC, sub { + my ( $self, $filename ) = @_; + for my $dir (@hook_dirs) { + my $candidate = + File::Spec->catfile( $dir, split( '/', $filename ) ); + next unless -f $candidate; + register_abs_path( $opt->{site_perl_root}, + $traced_relpaths, $traced_modules, $opt->{perl_version}, + $candidate ); + open my $fh, '<', $candidate or die "open $candidate: $!"; + return ( $fh, $candidate ); + } + return; + }; + + for my $module ( @{ $opt->{use_modules} } ) { + eval { require $module; $module->import(); 1 } + or warn "trace use $module failed: $@"; + } + + for my $module ( @{ $opt->{require_modules} } ) { + eval { require $module; 1 } or warn "trace require $module failed: $@"; + } + + for my $code ( @{ $opt->{eval_snippets} } ) { + eval $code; ##no critic qw(ProhibitStringyEval) + warn "trace eval failed: $@" if $@; + } + + for my $script ( @{ $opt->{entry_scripts} } ) { + next unless defined $script && -f $script; + { + local @ARGV = @{ $opt->{entry_args} || [] }; + local *CORE::GLOBAL::exit = sub { die "__TRACE_EXIT__\n" }; + eval { do $script }; + if ($@) { + next if $@ =~ /^__TRACE_EXIT__/; + warn "trace do $script failed: $@"; + } + } + } + + for my $inc_path ( values %INC ) { + register_abs_path( $opt->{site_perl_root}, + $traced_relpaths, $traced_modules, $opt->{perl_version}, + $inc_path ); + } + + { + my @files = grep { defined && -f $_ } @{ $opt->{entry_scripts} }; + for my $module ( @{ $opt->{use_modules} } ) { + ( my $rel = $module ) =~ s{::}{/}g; + my $fn = File::Spec->catfile( $opt->{site_perl_root}, "$rel.pm" ); + if ( -f $fn ) { + push @files, $fn; + } + } + if (@files) { + my $rv = Module::ScanDeps::scan_deps( + files => \@files, + recurse => 1, + ); + for my $dep ( values %{ $rv || {} } ) { + register_abs_path( $opt->{site_perl_root}, + $traced_relpaths, $traced_modules, $opt->{perl_version}, + $dep->{file} ); + } + } + } + + for my $warmup ( @{ $opt->{warmup_files} } ) { + next unless defined $warmup && -f $warmup; + open my $fh, '<', $warmup or die "open $warmup: $!"; ##no critic qw(RequireBriefOpen) + while ( my $line = <$fh> ) { + chomp $line; + next if $line =~ /^\s*$/; + if ( $line =~ + m{^(?:lib/)?\Q$opt->{perl_version}\E/wasm32-wasi/(.+)$} ) + { + register_relpath( $traced_relpaths, $traced_modules, + $opt->{perl_version}, + "lib/$opt->{perl_version}/wasm32-wasi/$1" ); + my $module = module_name_from_relpath($1); + $traced_modules->{$module} = 1 if defined $module; + } + elsif ( index( $line, $opt->{site_perl_root} ) == 0 ) { + register_abs_path( $opt->{site_perl_root}, + $traced_relpaths, $traced_modules, $opt->{perl_version}, + $line ); + } + else { + $line = normalize_relpath($line); + register_relpath( $traced_relpaths, $traced_modules, + $opt->{perl_version}, $line ); + if ( $line =~ + m{^lib/\Q$opt->{perl_version}\E/wasm32-wasi/(.+)$} ) + { + my $module = module_name_from_relpath($1); + $traced_modules->{$module} = 1 if defined $module; + } + } + } + close $fh; + } + + if ( defined $opt->{allowlist} && -f $opt->{allowlist} ) { + open my $fh, '<', $opt->{allowlist} or die "open $opt->{allowlist}: $!"; ##no critic qw(RequireBriefOpen) + while ( my $line = <$fh> ) { + chomp $line; + $line =~ s/\s+#.*$//; + next if $line =~ /^\s*$/; + $line = normalize_relpath($line); + register_relpath( $traced_relpaths, $traced_modules, + $opt->{perl_version}, $line ); + if ( $line =~ m{^lib/\Q$opt->{perl_version}\E/wasm32-wasi/(.+)$} ) { + my $module = module_name_from_relpath($1); + $traced_modules->{$module} = 1 if defined $module; + } + } + close $fh; + } + + expand_package_trees( + $opt->{expand_explicit_package_trees}, + $opt->{expand_dependency_package_trees}, + $opt->{site_perl_root}, + $opt->{perl_version}, + $opt->{explicit_packages}, + $opt->{use_modules}, + $opt->{require_modules}, + $traced_relpaths, + $traced_modules + ); + + include_auto_companion_artifacts( + $opt->{site_perl_root}, $traced_relpaths, $traced_modules, + $opt->{perl_version}, $opt->{native_prefix} + ); + + my @ext_names; + my %seen_ext; + find( + sub { + return unless /\.a$/; + my $archive = $File::Find::name; + for my $module ( keys %{$traced_modules} ) { + ( my $module_path = $module ) =~ s{::}{/}g; + if ( $archive =~ m{/auto/\Q$module_path\E/[^/]+\.a$} ) { + $seen_ext{$module_path} = 1; + } + } + }, + $opt->{native_prefix}, + ); + @ext_names = sort keys %seen_ext; + + for my $path ( $opt->{output}, $opt->{xs_output} ) { + my $dir = dirname($path); + make_path($dir) if defined $dir && length $dir && !-d $dir; + } + + open my $out_fh, '>', $opt->{output} or die "open $opt->{output}: $!"; + print {$out_fh} "$_\n" for sort keys %{$traced_relpaths}; + close $out_fh; + + open my $xs_fh, '>', $opt->{xs_output} or die "open $opt->{xs_output}: $!"; + print {$xs_fh} "$_\n" for @ext_names; + close $xs_fh; + + return(0); +} + +sub getoptions { + my $opt = { + site_perl_root => undef, + native_prefix => undef, + perl_version => undef, + output => undef, + xs_output => undef, + allowlist => undef, + warmup_files => [], + use_modules => [], + require_modules => [], + explicit_packages => [], + eval_snippets => [], + entry_scripts => [], + entry_args => [], + expand_explicit_package_trees => 1, + expand_dependency_package_trees => 1, + }; + + GetOptions( + 'site-perl-root=s' => \$opt->{site_perl_root}, + 'native-prefix=s' => \$opt->{native_prefix}, + 'perl-version=s' => \$opt->{perl_version}, + 'output=s' => \$opt->{output}, + 'xs-output=s' => \$opt->{xs_output}, + 'allowlist=s' => \$opt->{allowlist}, + 'warmup-file=s@' => $opt->{warmup_files}, + 'use=s@' => $opt->{use_modules}, + 'require=s@' => $opt->{require_modules}, + 'explicit-package=s@' => $opt->{explicit_packages}, + 'eval=s@' => $opt->{eval_snippets}, + 'entry-script=s@' => $opt->{entry_scripts}, + 'entry-arg=s@' => $opt->{entry_args}, + 'expand-explicit-package-trees!' => + \$opt->{expand_explicit_package_trees}, + 'expand-dependency-package-trees!' => + \$opt->{expand_dependency_package_trees}, + ) or die "bad options\n"; + + die "--native-prefix required\n" unless defined $opt->{native_prefix}; + die "--perl-version required\n" unless defined $opt->{perl_version}; + die "--output required\n" unless defined $opt->{output}; + die "--xs-output required\n" unless defined $opt->{xs_output}; + + $opt->{site_perl_root} //= + File::Spec->catdir( $opt->{native_prefix}, 'lib', 'perl5', 'site_perl', + $opt->{perl_version} ); + + return $opt; +} + +sub split_module_list { + my ( @in ) = @_; + my @items; + for my $raw (@in) { + next unless defined $raw; + for my $item ( split /,/, $raw ) { + $item =~ s/^\s+//; + $item =~ s/\s+$//; + next unless length $item; + push @items, $item; + } + } + return @items; +} + +sub normalize_module_name { + my ($module) = @_; + return unless defined $module; + $module =~ s/^\s+//; + $module =~ s/\s+$//; + return unless length $module; + $module =~ s{\.(?:pm|pl)$}{}; + $module =~ s{/}{::}g; + return $module; +} + +sub module_path_from_name { + my ($module) = @_; + return unless defined $module; + $module =~ s{::}{/}g; + return $module; +} + +sub normalize_relpath { + my ($path) = @_; + $path =~ s{\\}{/}g; + $path =~ s{^\./}{}; + return $path; +} + +sub module_name_from_relpath { + my ($relpath) = @_; + return unless $relpath =~ /\.(?:pm|pl)$/; + ( my $module = $relpath ) =~ s/\.(?:pm|pl)$//; + $module =~ s{/}{::}g; + return $module; +} + +sub register_relpath { + my ( $traced_relpaths, $traced_modules, $perl_version, $relpath ) = @_; + return unless defined $relpath; + $relpath = normalize_relpath($relpath); + return unless length $relpath; + $traced_relpaths->{$relpath} = 1; + if ( $relpath =~ m{^lib/\Q$perl_version\E/wasm32-wasi/(.+)$} ) { + my $module = module_name_from_relpath($1); + $traced_modules->{$module} = 1 if defined $module; + } +} + +sub register_abs_path { + my ( + $site_perl_root, $traced_relpaths, $traced_modules, + $perl_version, $path + ) = @_; + return unless defined $path && -f $path; + my $rel; + if ( index( $path, $site_perl_root ) == 0 ) { + $rel = File::Spec->abs2rel( $path, $site_perl_root ); + $rel = normalize_relpath($rel); + register_relpath( $traced_relpaths, $traced_modules, $perl_version, + "lib/$perl_version/wasm32-wasi/$rel" ); + my $module = module_name_from_relpath($rel); + $traced_modules->{$module} = 1 if defined $module; + } +} + +sub register_site_relative_abs_path { + my ( + $site_perl_root, $traced_relpaths, $traced_modules, + $perl_version, $abs_path + ) = @_; + return unless defined $abs_path && -f $abs_path; + return unless index( $abs_path, $site_perl_root ) == 0; + my $rel = File::Spec->abs2rel( $abs_path, $site_perl_root ); + register_relpath( $traced_relpaths, $traced_modules, $perl_version, + "lib/$perl_version/wasm32-wasi/" . normalize_relpath($rel) ); +} + +sub include_autosplit_targets { + my ( + $site_perl_root, $traced_relpaths, $traced_modules, + $perl_version, $autosplit_ix + ) = @_; + return unless -f $autosplit_ix; + open my $ix_fh, '<', $autosplit_ix or die "open $autosplit_ix: $!"; ##no critic qw(RequireBriefOpen) + while ( my $line = <$ix_fh> ) { + chomp $line; + next if $line =~ /^\s*$/; + next if $line =~ /^\s*#/; + my ($target) = split /\s+/, $line, 2; + next unless defined $target && length $target; + my $target_path = + File::Spec->catfile( dirname($autosplit_ix), split( '/', $target ) ); + register_site_relative_abs_path( + $site_perl_root, $traced_relpaths, $traced_modules, + $perl_version, $target_path + ); + } + close $ix_fh; +} + +sub include_auto_companion_artifacts { + my ( + $site_perl_root, $traced_relpaths, $traced_modules, + $perl_version, $native_prefix + ) = @_; + + my %module_paths; + for my $module ( keys %{$traced_modules} ) { + ( my $module_path = $module ) =~ s{::}{/}g; + $module_paths{$module_path} = 1; + } + + for my $module_path ( sort keys %module_paths ) { + my $auto_dir = File::Spec->catdir( $site_perl_root, 'auto', + split( '/', $module_path ) ); + next unless -d $auto_dir; + + my $autosplit_ix = File::Spec->catfile( $auto_dir, 'autosplit.ix' ); + if ( -f $autosplit_ix ) { + register_site_relative_abs_path( + $site_perl_root, $traced_relpaths, $traced_modules, + $perl_version, $autosplit_ix + ); + include_autosplit_targets( + $site_perl_root, $traced_relpaths, $traced_modules, + $perl_version, $autosplit_ix + ); + } + + my $extra_libs = File::Spec->catfile( $auto_dir, 'extralibs.ld' ); + register_site_relative_abs_path( + $site_perl_root, $traced_relpaths, $traced_modules, + $perl_version, $extra_libs + ) if -f $extra_libs; + } +} + +sub include_module_package_tree { + my ( + $site_perl_root, $traced_relpaths, $traced_modules, + $perl_version, $module + ) = @_; + my $module_path = module_path_from_name($module); + return unless defined $module_path && length $module_path; + + for my $suffix ( '.pm', '.pl' ) { + my $module_file = File::Spec->catfile( $site_perl_root, + split( '/', $module_path . $suffix ) ); + register_site_relative_abs_path( + $site_perl_root, $traced_relpaths, $traced_modules, + $perl_version, $module_file + ) if -f $module_file; + } + + my $module_dir = + File::Spec->catdir( $site_perl_root, split( '/', $module_path ) ); + return unless -d $module_dir; + + find( + sub { + return unless -f $_; + return unless /\.(?:pm|pl|al)$/; + register_site_relative_abs_path( + $site_perl_root, $traced_relpaths, $traced_modules, + $perl_version, $File::Find::name + ); + }, + $module_dir, + ); +} + +sub expand_package_trees { + my ( + $expand_explicit_package_trees, $expand_dependency_package_trees, + $site_perl_root, $perl_version, + $explicit_packages, $use_modules, + $require_modules, $traced_relpaths, + $traced_modules + ) = @_; + my %seen; + + if ($expand_explicit_package_trees) { + my @explicit_modules = + split_module_list( @{$explicit_packages}, @{$use_modules}, + @{$require_modules} ); + for my $module (@explicit_modules) { + $module = normalize_module_name($module); + next unless defined $module; + next if $seen{"explicit:$module"}++; + include_module_package_tree( + $site_perl_root, $traced_relpaths, $traced_modules, + $perl_version, $module + ); + } + } + + if ($expand_dependency_package_trees) { + for my $module ( sort keys %{$traced_modules} ) { + next if $seen{"dependency:$module"}++; + include_module_package_tree( + $site_perl_root, $traced_relpaths, $traced_modules, + $perl_version, $module + ); + } + } +} + diff --git a/tools/unicore-strip.pl b/tools/unicore-strip.pl new file mode 100644 index 0000000..7785e94 --- /dev/null +++ b/tools/unicore-strip.pl @@ -0,0 +1,37 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use File::Find qw(find); +use File::Spec; + +my $root = shift @ARGV or die "usage: $0 \n"; +my @targets = grep { -d $_ } ( + File::Spec->catdir($root, 'wasm32-wasi'), + File::Spec->catdir($root, 'unicore'), +); + +exit 0 unless @targets; + +find( + sub { + return unless -f $_; + return unless $File::Find::name =~ m{/unicore/.*\.pl$}; + if ($_ eq 'TestProp.pl') { + unlink $File::Find::name or die "unlink $File::Find::name: $!"; + return; + } + open my $in, '<', $File::Find::name or die "open $File::Find::name: $!"; + my @out; + while (my $line = <$in>) { + next if $line =~ /^\s*#/; + next if $line =~ /^\s*$/; + push @out, $line; + } + close $in; + open my $out, '>', $File::Find::name or die "open $File::Find::name: $!"; + print {$out} @out; + close $out; + }, + @targets, +); diff --git a/tools/verify-embedded-inc.mjs b/tools/verify-embedded-inc.mjs new file mode 100644 index 0000000..bdf54a7 --- /dev/null +++ b/tools/verify-embedded-inc.mjs @@ -0,0 +1,119 @@ +#!/usr/bin/env node + +import { access, readFile } from "node:fs/promises"; +import { constants as fsConstants } from "node:fs"; +import path from "node:path"; +import { fileURLToPath } from "node:url"; + +import { MemoryFileSystem, ZeroPerl } from "@6over3/zeroperl-ts"; + +const decoder = new TextDecoder(); +const __filename = fileURLToPath(import.meta.url); +const __dirname = path.dirname(__filename); +const repoRoot = path.resolve(__dirname, ".."); + +function decodeChunk(chunk) { + return typeof chunk === "string" ? chunk : decoder.decode(chunk); +} + +function extractIncLines(output) { + const match = output.match(/__INC_BEGIN__\n([\s\S]*?)__INC_END__/); + if (!match) { + throw new Error(`missing @INC markers in output:\n${output}`); + } + + return match[1] + .split("\n") + .map((line) => line.trim()) + .filter(Boolean); +} + +function assertEmbeddedInc(incLines) { + const hasLib = incLines.some((line) => + /^\/zeroperl\/lib\/\d+\.\d+\.\d+$/.test(line), + ); + const hasArch = incLines.some((line) => + /^\/zeroperl\/lib\/\d+\.\d+\.\d+\/wasm32-wasi$/.test(line), + ); + + if (!hasLib || !hasArch) { + throw new Error( + `embedded @INC paths missing\n${incLines.map((line) => `- ${line}`).join("\n")}`, + ); + } +} + +async function main() { + const wasmPath = path.resolve( + process.argv[2] ?? path.join(repoRoot, "output", "zeroperl.wasm"), + ); + + await access(wasmPath, fsConstants.R_OK); + const wasmBinary = await readFile(wasmPath); + + let stdout = ""; + let stderr = ""; + + const perl = await ZeroPerl.create({ + fetch: async () => + new Response(wasmBinary, { + headers: { "content-type": "application/wasm" }, + }), + fileSystem: new MemoryFileSystem(), + stdout: (chunk) => { + stdout += decodeChunk(chunk); + }, + stderr: (chunk) => { + stderr += decodeChunk(chunk); + }, + }); + + try { + const result = await perl.eval(` + use strict; + use warnings; + $| = 1; + + print "__INC_BEGIN__\\n"; + print "$_\\n" for @INC; + print "__INC_END__\\n"; + + require File::Glob; + require Image::ExifTool; + require Image::ExifTool::XMP; + + print "__MODULE_OK__\\n"; + `); + perl.flush(); + + if (!result.success) { + throw new Error( + [ + `perl eval failed with exit code ${result.exitCode}`, + result.error ? `eval error: ${result.error}` : "", + stderr ? `stderr:\n${stderr}` : "", + ] + .filter(Boolean) + .join("\n"), + ); + } + + const incLines = extractIncLines(stdout); + assertEmbeddedInc(incLines); + + if (!stdout.includes("__MODULE_OK__")) { + throw new Error( + `module load marker missing\nstdout:\n${stdout}\nstderr:\n${stderr}`, + ); + } + + process.stdout.write(`Embedded @INC verification passed for ${wasmPath}\n`); + } finally { + perl.dispose(); + } +} + +main().catch((err) => { + process.stderr.write(`${err instanceof Error ? err.message : String(err)}\n`); + process.exitCode = 1; +}); diff --git a/tools/wasm-shrink.env b/tools/wasm-shrink.env new file mode 100644 index 0000000..6f53d07 --- /dev/null +++ b/tools/wasm-shrink.env @@ -0,0 +1,11 @@ +: "${ZEROPERL_SHRINK:=off}" +# : "${TRACE_ENTRY_SCRIPT:=exiftool.min.pl}" +# : "${TRACE_USE_MODULE:=Image::ExifTool}" +: "${TRACE_EXPLICIT_PACKAGES:=}" +: "${TRACE_ENTRY_ARGS:=-ver}" +: "${TRACE_EXPAND_EXPLICIT_PACKAGE_TREES:=true}" +: "${TRACE_EXPAND_DEPENDENCY_PACKAGE_TREES:=true}" +: "${TRACE_ALLOWLIST:=gen/extra-paths-allowlist.txt}" +: "${TRACE_WARMUP_INC:=gen/warmup-inc.txt}" +: "${TRACE_MISSING_REPORT:=gen/wasm-missing-paths.txt}" +: "${EXIFTOOL_WARMUP_MODE:=curated}" diff --git a/tools/wasm-smoke.mjs b/tools/wasm-smoke.mjs new file mode 100644 index 0000000..5851da8 --- /dev/null +++ b/tools/wasm-smoke.mjs @@ -0,0 +1,392 @@ +#!/usr/bin/env node + +import { readFile, readdir, stat } from "node:fs/promises"; +import path from "node:path"; +import { fileURLToPath } from "node:url"; +import { MemoryFileSystem, ZeroPerl } from "@6over3/zeroperl-ts"; + +const __filename = fileURLToPath(import.meta.url); +const __dirname = path.dirname(__filename); +const repoRoot = path.resolve(__dirname, ".."); + +function printUsage() { + console.log("Usage: wasm-smoke.mjs [prefixDir|exiftoolPath]"); + console.log(" wasmPath Path to zeroperl.wasm"); + console.log(" prefixDir External prefix directory (full prefix or test lib)"); + console.log(" exiftoolPath Path to exiftool.min.pl (embedded prefix + ExifTool smoke)"); +} + +function decodeChunk(chunk) { + if (typeof chunk === "string") return chunk; + if (chunk instanceof Uint8Array) return new TextDecoder().decode(chunk); + return String(chunk); +} + +function extractIncLines(output) { + const match = output.match(/__INC_BEGIN__\n([\s\S]*?)__INC_END__/); + if (!match) return []; + return match[1].split("\n").map((l) => l.trim()).filter(Boolean); +} + +function assertEmbeddedInc(incLines) { + const versioned = incLines.some((l) => /\/zeroperl\/lib\/\d+\.\d+\.\d+$/.test(l)); + const arch = incLines.some((l) => /\/zeroperl\/lib\/\d+\.\d+\.\d+\/wasm32-wasi$/.test(l)); + if (!versioned) throw new Error("Missing embedded versioned lib dir in @INC"); + if (!arch) throw new Error("Missing embedded arch subdir in @INC"); +} + +async function mountDirectory(fileSystem, sourceDir, targetDir) { + const entries = await readdir(sourceDir); + for (const entry of entries) { + const sourcePath = path.join(sourceDir, entry); + const targetPath = path.posix.join(targetDir, entry); + const st = await stat(sourcePath); + if (st.isDirectory()) { + fileSystem.ensureDir(targetPath); + await mountDirectory(fileSystem, sourcePath, targetPath); + } else if (st.isFile()) { + const content = await readFile(sourcePath); + fileSystem.addFile(targetPath, content); + } + } +} + +async function detectPrefixMountPoint(prefixDir) { + const libDir = path.join(prefixDir, "lib"); + try { + const entries = await readdir(libDir); + if (entries.some((e) => /^\d+\.\d+\.\d+$/.test(e))) { + return "/prefix"; + } + } catch {} + return "/lib"; +} + +async function findPerlVersion(prefixDir) { + const libDir = path.join(prefixDir, "lib"); + const entries = await readdir(libDir); + for (const entry of entries) { + if (/^\d+\.\d+\.\d+$/.test(entry)) { + return entry; + } + } + return null; +} + +function decodeBase64File(content) { + return Uint8Array.from(Buffer.from(content.replace(/\s+/g, ""), "base64")); +} + +function assertRunSuccess(label, result, stdout, stderr) { + if (result.success) return; + throw new Error( + [ + `${label} failed with exit code ${result.exitCode}`, + result.error ? `run error: ${result.error}` : "", + stdout ? `stdout:\n${stdout}` : "", + stderr ? `stderr:\n${stderr}` : "", + ] + .filter(Boolean) + .join("\n"), + ); +} + +function parseJsonOutput(label, stdout, stderr) { + const trimmed = stdout.trim(); + if (!trimmed) throw new Error(`${label} produced empty stdout\nstderr:\n${stderr}`); + try { + return JSON.parse(trimmed); + } catch (err) { + throw new Error( + [ + `${label} produced invalid JSON`, + err instanceof Error ? err.message : String(err), + `stdout:\n${stdout}`, + stderr ? `stderr:\n${stderr}` : "", + ] + .filter(Boolean) + .join("\n"), + ); + } +} + +function assertStringOutput(label, stdout, stderr) { + if (stdout.trim()) return; + throw new Error(`${label} produced empty stdout\nstderr:\n${stderr}`); +} + +async function runExifTool(perl, exiftoolScript, smokeFiles, args) { + const fileSystem = new MemoryFileSystem(); + fileSystem.addFile("/work/exiftool.min.pl", exiftoolScript); + fileSystem.addFile("/work/sample.jpg", smokeFiles.sampleJpg); + fileSystem.addFile("/work/sample.tiff", smokeFiles.sampleTiff); + fileSystem.addFile("/work/sample.xmp", smokeFiles.sampleXmp); + + let stdout = ""; + let stderr = ""; + + const runPerl = await ZeroPerl.create({ + fetch: perl._fetch, + fileSystem, + stdout: (chunk) => { + const text = decodeChunk(chunk); + stdout += text; + }, + stderr: (chunk) => { + const text = decodeChunk(chunk); + stderr += text; + }, + }); + + try { + const result = await runPerl.runFile("/work/exiftool.min.pl", args); + runPerl.flush(); + return { result, stdout, stderr }; + } finally { + runPerl.dispose(); + } +} + +async function main() { + const args = process.argv.slice(2); + + if (args.length === 0 || args[0] === "--help" || args[0] === "-h") { + printUsage(); + process.exit(args.length === 0 ? 1 : 0); + } + + if (args.length > 2) { + printUsage(); + process.exit(1); + } + + const wasmPath = args[0]; + const extraPath = args[1]; + + let prefixDir = ""; + let exiftoolPath = ""; + + if (extraPath) { + const st = await stat(extraPath); + if (st.isDirectory()) { + prefixDir = extraPath; + } else { + exiftoolPath = extraPath; + } + } + + const wasmBinary = await readFile(wasmPath); + const fileSystem = new MemoryFileSystem(); + // /work is required because core-smoke.pl writes to /work/_smoke_tmp via IO::File + fileSystem.ensureDir("/work"); + + // Always mount tests/smoke/lib so Core::TestMod is available for core-mod-smoke.pl + await mountDirectory(fileSystem, path.join(repoRoot, "tests", "smoke", "lib"), "/lib"); + + let mountPoint = ""; + let perlVersion = ""; + if (prefixDir) { + mountPoint = await detectPrefixMountPoint(prefixDir); + await mountDirectory(fileSystem, prefixDir, mountPoint); + if (mountPoint === "/prefix") { + perlVersion = await findPerlVersion(prefixDir); + } + } + + const env = {}; + if (mountPoint === "/prefix" && perlVersion) { + env.PERL5LIB = `/prefix/lib/${perlVersion}/wasm32-wasi:/prefix/lib/${perlVersion}:/lib`; + } else { + env.PERL5LIB = "/lib"; + } + + let stdoutBuffer = ""; + let stderrBuffer = ""; + + const perl = await ZeroPerl.create({ + fetch: async () => new Response(wasmBinary, { headers: { "content-type": "application/wasm" } }), + fileSystem, + stdout: (chunk) => { + const text = decodeChunk(chunk); + stdoutBuffer += text; + process.stdout.write(text); + }, + stderr: (chunk) => { + const text = decodeChunk(chunk); + stderrBuffer += text; + process.stderr.write(text); + }, + env: Object.keys(env).length ? env : undefined, + }); + + console.log("ZEROPERL_INIT_OK"); + + // Verify @INC + const incScript = exiftoolPath + ? ` + print "__INC_BEGIN__\\n"; + print "$_\\n" for @INC; + print "__INC_END__\\n"; + require File::Glob; + require Image::ExifTool; + require Image::ExifTool::XMP; + print "__MODULE_OK__\\n"; + ` + : 'print "__INC_BEGIN__\n"; print "$_\n" for @INC; print "__INC_END__\n";'; + + const incResult = await perl.eval(incScript); + perl.flush(); + if (!incResult.success || incResult.exitCode !== 0) { + throw new Error(`@INC verification failed: ${incResult.error || "unknown error"}`); + } + const incLines = extractIncLines(stdoutBuffer); + assertEmbeddedInc(incLines); + console.log("EMBEDDED_INC_OK"); + + if (exiftoolPath && !stdoutBuffer.includes("__MODULE_OK__")) { + throw new Error(`ExifTool module load marker missing\nstdout:\n${stdoutBuffer}\nstderr:\n${stderrBuffer}`); + } + + if (prefixDir) { + if (mountPoint === "/prefix") { + const hasExternal = incLines.some((l) => l.startsWith("/prefix/lib/")); + if (!hasExternal) throw new Error("Missing external /prefix/lib/ in @INC"); + } else { + const hasExternal = incLines.some((l) => l.startsWith(mountPoint)); + if (!hasExternal) throw new Error(`Missing external ${mountPoint} in @INC`); + } + console.log("EXTERNAL_INC_OK"); + } + + // Always verify /lib is in @INC so Core::TestMod resolves + if (!incLines.includes("/lib")) throw new Error("Missing /lib in @INC"); + console.log("TESTLIB_INC_OK"); + + // Core smoke + const coreSmoke = await readFile(path.join(repoRoot, "tests", "smoke", "core-smoke.pl"), "utf8"); + const coreResult = await perl.eval(coreSmoke); + perl.flush(); + if (!coreResult.success || coreResult.exitCode !== 0) { + throw new Error(`core-smoke.pl failed: ${coreResult.error || "unknown error"}`); + } + if (!stdoutBuffer.includes("CORE_SMOKE_OK")) throw new Error("core-smoke.pl did not print CORE_SMOKE_OK"); + console.log("CORE_SMOKE_PL_OK"); + + // Core mod smoke + const coreModSmoke = await readFile(path.join(repoRoot, "tests", "smoke", "core-mod-smoke.pl"), "utf8"); + const modResult = await perl.eval(coreModSmoke); + perl.flush(); + if (!modResult.success || modResult.exitCode !== 0) { + throw new Error(`core-mod-smoke.pl failed: ${modResult.error || "unknown error"}`); + } + if (!stdoutBuffer.includes("CORE_SMOKE_OK")) throw new Error("core-mod-smoke.pl did not print CORE_SMOKE_OK"); + console.log("CORE_MOD_SMOKE_PL_OK"); + + // ExifTool smoke tests + if (exiftoolPath) { + const exiftoolScript = await readFile(exiftoolPath); + const [sampleJpgB64, sampleTiffB64, sampleXmp] = await Promise.all([ + readFile(path.join(repoRoot, "tests", "smoke", "sample.jpg.b64"), "utf8"), + readFile(path.join(repoRoot, "tests", "smoke", "sample.tiff.b64"), "utf8"), + readFile(path.join(repoRoot, "tests", "smoke", "sample.xmp")), + ]); + const smokeFiles = { + sampleJpg: decodeBase64File(sampleJpgB64), + sampleTiff: decodeBase64File(sampleTiffB64), + sampleXmp: sampleXmp, + }; + + // ExifTool -ver + const versionRun = await runExifTool(perl, exiftoolScript, smokeFiles, ["-ver"]); + assertRunSuccess("exiftool -ver", versionRun.result, versionRun.stdout, versionRun.stderr); + assertStringOutput("exiftool -ver", versionRun.stdout, versionRun.stderr); + console.log("EXIFTOOL_VER_OK"); + + // ExifTool -json sample.jpg + const jsonRun = await runExifTool(perl, exiftoolScript, smokeFiles, ["-json", "/work/sample.jpg"]); + assertRunSuccess("exiftool -json sample.jpg", jsonRun.result, jsonRun.stdout, jsonRun.stderr); + const jsonResult = parseJsonOutput("exiftool -json sample.jpg", jsonRun.stdout, jsonRun.stderr); + if (!Array.isArray(jsonResult) || jsonResult.length !== 1) { + throw new Error(`expected one JSON result for sample.jpg\nstdout:\n${jsonRun.stdout}`); + } + const sampleFields = jsonResult[0]; + if (!sampleFields || typeof sampleFields !== "object") { + throw new Error(`missing JSON fields for sample.jpg\nstdout:\n${jsonRun.stdout}`); + } + if (!sampleFields.ExifToolVersion) { + throw new Error(`missing ExifToolVersion in sample.jpg JSON\nstdout:\n${jsonRun.stdout}`); + } + if (sampleFields.FileType !== "JPEG") { + throw new Error(`expected FileType=JPEG, got ${String(sampleFields.FileType)}`); + } + if (sampleFields.MIMEType !== "image/jpeg") { + throw new Error(`expected MIMEType=image/jpeg, got ${String(sampleFields.MIMEType)}`); + } + console.log("EXIFTOOL_JPEG_OK"); + + // ExifTool -json -FileType -MIMEType sample.jpg + const multipleArgsRun = await runExifTool(perl, exiftoolScript, smokeFiles, ["-json", "-FileType", "-MIMEType", "/work/sample.jpg"]); + assertRunSuccess("exiftool -json -FileType -MIMEType sample.jpg", multipleArgsRun.result, multipleArgsRun.stdout, multipleArgsRun.stderr); + const multipleArgsResult = parseJsonOutput("exiftool -json -FileType -MIMEType sample.jpg", multipleArgsRun.stdout, multipleArgsRun.stderr); + if (!Array.isArray(multipleArgsResult) || multipleArgsResult.length !== 1) { + throw new Error(`expected one JSON result for -FileType -MIMEType sample.jpg\nstdout:\n${multipleArgsRun.stdout}`); + } + const selectedFields = multipleArgsResult[0]; + if (!selectedFields || typeof selectedFields !== "object") { + throw new Error(`missing selected JSON fields\nstdout:\n${multipleArgsRun.stdout}`); + } + if (selectedFields.FileType !== "JPEG") { + throw new Error(`expected selected FileType=JPEG, got ${String(selectedFields.FileType)}`); + } + if (selectedFields.MIMEType !== "image/jpeg") { + throw new Error(`expected selected MIMEType=image/jpeg, got ${String(selectedFields.MIMEType)}`); + } + console.log("EXIFTOOL_SELECTED_OK"); + + // ExifTool -json sample.tiff + const tiffRun = await runExifTool(perl, exiftoolScript, smokeFiles, ["-json", "/work/sample.tiff"]); + assertRunSuccess("exiftool sample.tiff", tiffRun.result, tiffRun.stdout, tiffRun.stderr); + const tiffResult = parseJsonOutput("exiftool sample.tiff", tiffRun.stdout, tiffRun.stderr); + if (!Array.isArray(tiffResult) || tiffResult.length !== 1) { + throw new Error(`expected one JSON result for sample.tiff\nstdout:\n${tiffRun.stdout}`); + } + const tiffFields = tiffResult[0]; + if (tiffFields.FileType !== "TIFF") { + throw new Error(`expected TIFF FileType, got ${String(tiffFields.FileType)}`); + } + if (tiffFields.ImageSize !== "1x1") { + throw new Error(`expected TIFF ImageSize=1x1, got ${String(tiffFields.ImageSize)}`); + } + console.log("EXIFTOOL_TIFF_OK"); + + // ExifTool -json sample.jpg sample.xmp + const sidecarRun = await runExifTool(perl, exiftoolScript, smokeFiles, ["-json", "/work/sample.jpg", "/work/sample.xmp"]); + assertRunSuccess("exiftool sample.jpg sample.xmp", sidecarRun.result, sidecarRun.stdout, sidecarRun.stderr); + const sidecarResult = parseJsonOutput("exiftool sample.jpg sample.xmp", sidecarRun.stdout, sidecarRun.stderr); + if (!Array.isArray(sidecarResult) || sidecarResult.length !== 2) { + throw new Error(`expected two JSON results for sample.jpg + sample.xmp\nstdout:\n${sidecarRun.stdout}`); + } + const xmpFields = sidecarResult.find((entry) => entry?.SourceFile === "/work/sample.xmp"); + if (!xmpFields) { + throw new Error(`missing XMP result in multi-file run\nstdout:\n${sidecarRun.stdout}`); + } + if (xmpFields.Title !== "zeroperl smoke sample") { + throw new Error(`expected XMP Title, got ${String(xmpFields.Title)}`); + } + if (xmpFields.Description !== "sidecar metadata sample") { + throw new Error(`expected XMP Description, got ${String(xmpFields.Description)}`); + } + console.log("EXIFTOOL_SIDECAR_OK"); + } + + perl.shutdown(); + perl.dispose(); + console.log("WASM_SMOKE_OK"); +} + +main() + .then(() => process.exit(0)) + .catch((err) => { + process.stderr.write(`${err instanceof Error ? err.message : String(err)}\n`); + process.exit(1); + }); diff --git a/tools/wasm-smoke.sh b/tools/wasm-smoke.sh new file mode 100755 index 0000000..a574d36 --- /dev/null +++ b/tools/wasm-smoke.sh @@ -0,0 +1,105 @@ +#!/bin/sh +set -e + +ROOT="${1:-.}" +SMOKE_SRC="$ROOT/tests/smoke" +SMOKE_TMP="${TMPDIR:-/tmp}/zeroperl-smoke.$$" +LOG_FILE="$SMOKE_TMP/smoke.log" +MISSING_OUT="$ROOT/gen/wasm-missing-paths.txt" +PERSISTENT_LOG="$ROOT/gen/wasm-smoke.log" + +cleanup() { + rm -rf "$SMOKE_TMP" +} +trap cleanup EXIT INT TERM + +find_perl_lib_base() { + lib_root="$1" + find "$lib_root" -mindepth 1 -maxdepth 1 -type d \ + | awk -F/ 'tolower($NF) ~ /^[0-9]+(\.[0-9]+)*$/ { print; exit }' +} + +mkdir -p "$SMOKE_TMP" "$ROOT/gen" + +if [ -f "/build/repo/exiftool.min.pl" ] && [ -d "/zeroperl/lib" ] && [ -x "/build/native/prefix/bin/perl" ]; then + PERL_BIN="/build/native/prefix/bin/perl" + EXIFTOOL_SCRIPT="/build/repo/exiftool.min.pl" + PERL_LIB_BASE="$(find_perl_lib_base /zeroperl/lib)" + USE_ARCH_LIB=1 +elif [ -f "$ROOT/output/exiftool.min.pl" ] && [ -d "$ROOT/output/perl-wasi-prefix/lib" ]; then + PERL_BIN="${PERL_BIN:-perl}" + EXIFTOOL_SCRIPT="$ROOT/output/exiftool.min.pl" + PERL_LIB_BASE="$(find_perl_lib_base "$ROOT/output/perl-wasi-prefix/lib")" + PERL_SITE_BASE="$(find_perl_lib_base "$ROOT/output/perl-wasi-prefix/lib/site_perl" 2>/dev/null || true)" + USE_ARCH_LIB=0 +else + echo "error: unsupported layout; expected either wasi build container layout or local output artifacts" >&2 + exit 1 +fi + +if [ -z "$PERL_LIB_BASE" ]; then + echo "error: unable to locate perl lib version directory" >&2 + exit 1 +fi + +ARCH_LIB="$PERL_LIB_BASE/wasm32-wasi" +if [ "$USE_ARCH_LIB" -eq 1 ]; then + if [ ! -d "$ARCH_LIB" ]; then + echo "error: missing arch lib directory: $ARCH_LIB" >&2 + exit 1 + fi +fi + +decode_b64() { + src="$1" + dst="$2" + if base64 -D -i "$src" -o "$dst" >/dev/null 2>&1; then + return 0 + fi + base64 -d "$src" > "$dst" +} + +decode_b64 "$SMOKE_SRC/sample.jpg.b64" "$SMOKE_TMP/sample.jpg" +decode_b64 "$SMOKE_SRC/sample.tiff.b64" "$SMOKE_TMP/sample.tiff" +cp "$SMOKE_SRC/sample.xmp" "$SMOKE_TMP/sample.xmp" + +if [ "$USE_ARCH_LIB" -eq 1 ]; then + PERL5LIB="$ARCH_LIB:$PERL_LIB_BASE" +else + PERL5LIB="$PERL_LIB_BASE" + if [ -n "${PERL_SITE_BASE:-}" ]; then + PERL5LIB="$PERL_SITE_BASE:$PERL5LIB" + fi +fi +export PERL5LIB + +run_smoke_cmd() { + if ! "$PERL_BIN" "$EXIFTOOL_SCRIPT" "$@" >>"$LOG_FILE" 2>&1; then + return 1 + fi + return 0 +} + +smoke_status=0 +run_smoke_cmd -ver || smoke_status=1 +run_smoke_cmd "$SMOKE_TMP/sample.jpg" || smoke_status=1 +run_smoke_cmd "$SMOKE_TMP/sample.tiff" || smoke_status=1 +run_smoke_cmd "$SMOKE_TMP/sample.jpg" "$SMOKE_TMP/sample.xmp" || smoke_status=1 + +perl "$ROOT/tools/extract-missing-paths.pl" "$LOG_FILE" "$MISSING_OUT" +cp "$LOG_FILE" "$PERSISTENT_LOG" + +if [ "$smoke_status" -ne 0 ]; then + echo "error: smoke command failure; see $PERSISTENT_LOG" >&2 + echo "--- smoke log follows ---" >&2 + cat "$PERSISTENT_LOG" >&2 + exit 1 +fi + +if [ -s "$MISSING_OUT" ]; then + echo "error: missing Perl paths detected during smoke run:" >&2 + cat "$MISSING_OUT" >&2 + exit 1 +fi + +echo "Smoke run completed with no missing module paths" diff --git a/tools/wasm-xs-kernel.txt b/tools/wasm-xs-kernel.txt new file mode 100644 index 0000000..3ed1473 --- /dev/null +++ b/tools/wasm-xs-kernel.txt @@ -0,0 +1,36 @@ +Compress/Raw/Bzip2 +Compress/Raw/Zlib +Cwd +Data/Dumper +Digest/MD5 +Digest/SHA +Encode +Encode/Byte +Encode/CN +Encode/EBCDIC +Encode/JP +Encode/KR +Encode/Symbol +Encode/TW +Encode/Unicode +Fcntl +File/Glob +Filter/Util/Call +Hash/Util +Hash/Util/FieldHash +I18N/Langinfo +IO +List/Util +MIME/Base64 +Math/BigInt/FastCalc +Opcode +PerlIO/encoding +PerlIO/mmap +PerlIO/via +Sys/Hostname +Time/HiRes +Time/Piece +Unicode/Collate +Unicode/Normalize +attributes +re diff --git a/zeroperl-ts b/zeroperl-ts new file mode 160000 index 0000000..88b3310 --- /dev/null +++ b/zeroperl-ts @@ -0,0 +1 @@ +Subproject commit 88b3310259b5c8633390e881c6590dfa81eab8e9