4 files changed, 100 insertions, 1 deletions
diff --git a/third_party/lisp/mime4cl/.skip-subtree b/third_party/lisp/mime4cl/.skip-subtree
deleted file mode 100644
index 5051f60d6b86..000000000000
--- a/third_party/lisp/mime4cl/.skip-subtree
+++ /dev/null
@@ -1 +0,0 @@
-prevent readTree from creating entries for subdirs that don't contain an .nix files
diff --git a/third_party/lisp/mime4cl/benchmark/bench.lisp b/third_party/lisp/mime4cl/benchmark/bench.lisp
new file mode 100644
index 000000000000..1a25f2010098
--- /dev/null
+++ b/third_party/lisp/mime4cl/benchmark/bench.lisp
@@ -0,0 +1,30 @@
+(defpackage :mime4cl-bench
+  (:use :common-lisp :mime4cl)
+  (:export :main))
+
+(in-package :mime4cl-bench)
+
+;; Write to /dev/null so that I/O is less (?) of a factor
+(defparameter *output-path* (pathname "/dev/null"))
+
+(defun parse-message (path)
+  (let ((msg (mime-message path)))
+    ;; to prove we are doing something, print the subject
+    (format t "Subject: ~A~%" (car (mime-message-header-values "Subject" msg :decode t)))
+    msg))
+
+(defun main ()
+  (destructuring-bind (bench-name message-path) (uiop:command-line-arguments)
+    (let ((action (intern (string-upcase bench-name) :mime4cl-bench))
+          (message-path (pathname message-path)))
+      (ccase action
+        ((parse) (parse-message message-path))
+        ((extract) (do-parts (part (parse-message message-path))
+                     (format t "Content-Type: ~A~%" (mime-type-string part))
+                     (let ((in (mime-body-stream part)))
+                       (with-open-file (output-stream (pathname *output-path*)
+                                                      :direction :output
+                                                      :if-does-not-exist :create
+                                                      :element-type (stream-element-type in)
+                                                      :if-exists :overwrite)
+                         (redirect-stream in output-stream)))))))))
diff --git a/third_party/lisp/mime4cl/benchmark/default.nix b/third_party/lisp/mime4cl/benchmark/default.nix
new file mode 100644
index 000000000000..b201ede740b4
--- /dev/null
+++ b/third_party/lisp/mime4cl/benchmark/default.nix
@@ -0,0 +1,69 @@
+{ depot, pkgs, lib, ... }:
+
+let
+  # Example email that's going to push the parser due to its big attachment
+  # of almost 200MB. We are using a GHC bindist since it's quite big and a
+  # fixed output derivation that's already part of nixpkgs, so whitby only
+  # needs to download it once (and it won't change).
+  message = pkgs.runCommand "huge.mime"
+    {
+      nativeBuildInputs = [ pkgs.buildPackages.mblaze ];
+    }
+    ''
+      mmime > $out <<EOF
+      Subject: Test message with a big attachment
+
+      Henlo world!
+
+      #application/gzip#base64 ${pkgs.haskell.compiler.ghc963Binary.src}
+      EOF
+    '';
+
+  inherit (depot.nix) buildLisp getBins;
+
+  benchmark-program = buildLisp.program {
+    name = "mime4cl-benchmark-program";
+
+    deps = [
+      {
+        sbcl = buildLisp.bundled "uiop";
+        default = buildLisp.bundled "asdf";
+      }
+      depot.third_party.lisp.mime4cl
+    ];
+
+    srcs = [
+      ./bench.lisp
+    ];
+
+    main = "mime4cl-bench:main";
+  };
+
+  commands = bench: {
+    mime4cl-message-parsing = "${bench} parse ${message}";
+    mime4cl-attachment-extraction = "${bench} extract ${message}";
+  };
+
+  # TODO(sterni): expose this information from //nix/buildLisp and generate automatically
+  lispImplementations = [ "sbcl" /* "ccl" "ecl" */ ];
+in
+
+(pkgs.writeShellScriptBin "mime4cl-benchmark" ''
+  exec ${pkgs.hyperfine}/bin/hyperfine \
+    ${
+      lib.escapeShellArgs (
+        lib.concatMap (impl:
+          lib.concatLists (
+            lib.mapAttrsToList (name: cmd:
+              [ "-n" "${impl}-${name}" cmd ]
+            ) (commands (let b = benchmark-program.${impl}; in "${b}/bin/${b.name}"))
+          )
+        ) lispImplementations
+      )
+    } \
+    "$@"
+'').overrideAttrs (oldAttrs: {
+  passthru = oldAttrs.passthru or  { } // {
+    inherit benchmark-program;
+  };
+})
diff --git a/third_party/lisp/mime4cl/test/.skip-tree b/third_party/lisp/mime4cl/test/.skip-tree
new file mode 100644
index 000000000000..28023cca596d
--- /dev/null
+++ b/third_party/lisp/mime4cl/test/.skip-tree
@@ -0,0 +1 @@
+parent exposes tests