aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014-2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2017, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu system mapped-devices)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module ((guix modules) #:hide (file-name->module-name))
  #:use-module (guix i18n)
  #:use-module ((guix diagnostics)
                #:select (source-properties->location
                          formatted-message
                          &fix-hint
                          &error-location))
  #:use-module (guix deprecation)
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system uuid)
  #:autoload   (gnu build file-systems) (find-partition-by-luks-uuid)
  #:autoload   (gnu build linux-modules)
                 (missing-modules)
  #:autoload   (gnu packages cryptsetup) (cryptsetup-static)
  #:autoload   (gnu packages linux) (mdadm-static lvm2-static)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:use-module (ice-9 match)
  #:use-module (ice-9 format)
  #:export (%mapped-device
            mapped-device
            mapped-device?
            mapped-device-source
            mapped-device-target
            mapped-device-targets
            mapped-device-type
            mapped-device-location

            mapped-device-kind
            mapped-device-kind?
            mapped-device-kind-open
            mapped-device-kind-close
            mapped-device-kind-modules
            mapped-device-kind-check

            device-mapping-service-type
            device-mapping-service

            check-device-initrd-modules           ;XXX: needs a better place

            luks-device-mapping
            luks-device-mapping-with-options
            raid-device-mapping
            lvm-device-mapping))

;;; Commentary:
;;;
;;; This module supports "device mapping", a concept implemented by Linux's
;;; device-mapper.
;;;
;;; Code:

(define-record-type* <mapped-device> %mapped-device
  make-mapped-device
  mapped-device?
  (source    mapped-device-source)                ;string | list of strings
  (targets   mapped-device-targets)               ;list of strings
  (type      mapped-device-type)                  ;<mapped-device-kind>
  (location  mapped-device-location
             (default (current-source-location)) (innate)))

(define-syntax mapped-device-compatibility-helper
  (syntax-rules (target)
    ((_ () (fields ...))
     (%mapped-device fields ...))
    ((_ ((target exp) rest ...) (others ...))
     (%mapped-device others ...
                      (targets (list exp))
                      rest ...))
    ((_ (field rest ...) (others ...))
     (mapped-device-compatibility-helper (rest ...)
                                         (others ... field)))))

(define-syntax-rule (mapped-device fields ...)
  "Build an <mapped-device> record, automatically converting 'target' field
specifications to 'targets'."
  (mapped-device-compatibility-helper (fields ...) ()))

(define-deprecated (mapped-device-target md)
  mapped-device-targets
  (car (mapped-device-targets md)))

(define-record-type* <mapped-device-type> mapped-device-kind
  make-mapped-device-kind
  mapped-device-kind?
  (open      mapped-device-kind-open)             ;source target -> gexp
  (close     mapped-device-kind-close             ;source target -> gexp
             (default (const #~(const #f))))
  (modules   mapped-device-kind-modules           ;list of module names
             (default '()))
  (check     mapped-device-kind-check             ;source -> Boolean
             (default (const #t))))


;;;
;;; Device mapping as a Shepherd service.
;;;

(define device-mapping-service-type
  (shepherd-service-type
   'device-mapping
   (match-lambda
     (($ <mapped-device> source targets
                         ($ <mapped-device-type> open close modules))
      (shepherd-service
       (provision (list (symbol-append 'device-mapping- (string->symbol (string-join targets "-")))))
       (requirement '(udev))
       (documentation "Map a device node using Linux's device mapper.")
       (start #~(lambda () #$(open source targets)))
       (stop #~(lambda _ (not #$(close source targets))))
       (modules (append %default-modules modules))
       (respawn? #f))))
   (description "Map a device node using Linux's device mapper.")))

(define (device-mapping-service mapped-device)
  "Return a service that sets up @var{mapped-device}."
  (service device-mapping-service-type mapped-device))


;;;
;;; Static checks.
;;;

(define (check-device-initrd-modules device linux-modules location)
  "Raise an error if DEVICE needs modules beyond LINUX-MODULES to operate.
DEVICE must be a \"/dev\" file name."
  (define missing
    ;; Attempt to determine missing modules.
    (catch 'system-error
      (lambda ()
        (missing-modules device linux-modules))

      ;; If we can't do that (e.g., EPERM), skip the whole thing.
      (const '())))

  (unless (null? missing)
    ;; Note: What we suggest here is a list of module names (e.g.,
    ;; "usb_storage"), not file names (e.g., "usb-storage.ko").  This is
    ;; OK because we have machinery that accepts both the hyphen and the
    ;; underscore version.
    (raise (make-compound-condition
            (formatted-message (G_ "you may need these modules \
in the initrd for ~a:~{ ~a~}")
                               device missing)
            (condition
             (&fix-hint
              (hint (format #f (G_ "Try adding them to the
@code{initrd-modules} field of your @code{operating-system} declaration, along
these lines:

@example
 (operating-system
   ;; @dots{}
   (initrd-modules (append (list~{ ~s~})
                           %base-initrd-modules)))
@end example

If you think this diagnostic is inaccurate, use the @option{--skip-checks}
option of @command{guix system}.\n")
                            missing))))
            (condition
             (&error-location
              (location (source-properties->location location))))))))


;;;
;;; Common device mappings.
;;;

(define* (open-luks-device source targets #:key key-file)
  "Return a gexp that maps SOURCE to TARGET as a LUKS device, using
'cryptsetup'."
  (with-imported-modules (source-module-closure
                          '((gnu build file-systems)
                            (guix build utils))) ;; For mkdir-p
    (match targets
      ((target)
       #~(let ((source #$(if (uuid? source)
                             (uuid-bytevector source)
                             source))
               (keyfile #$key-file))

           ;; Create '/run/cryptsetup/' if it does not exist, as device locking
           ;; is mandatory for LUKS2.
           (mkdir-p "/run/cryptsetup/")

           ;; Use 'cryptsetup-static', not 'cryptsetup', to avoid pulling the
           ;; whole world inside the initrd (for when we're in an initrd).
           ;; 'cryptsetup open' requires standard input to be a tty to allow
           ;; for interaction but shepherd sets standard input to /dev/null;
           ;; thus, explicitly request a tty.
           (let ((partition
                  ;; Note: We cannot use the "UUID=source" syntax here
                  ;; because 'cryptsetup' implements it by searching the
                  ;; udev-populated /dev/disk/by-id directory but udev may
                  ;; be unavailable at the time we run this.
                  (if (bytevector? source)
                      (or (let loop ((tries-left 10))
                            (and (positive? tries-left)
                                 (or (find-partition-by-luks-uuid source)
                                     ;; If the underlying partition is
                                     ;; not found, try again after
                                     ;; waiting a second, up to ten
                                     ;; times.  FIXME: This should be
                                     ;; dealt with in a more robust way.
                                     (begin (sleep 1)
                                            (loop (- tries-left 1))))))
                          (error "LUKS partition not found" source))
                      source)))
             ;; We want to fallback to the password unlock if the keyfile fails.
             (or (and keyfile
                      (zero? (system*/tty
                              #$(file-append cryptsetup-static "/sbin/cryptsetup")
                              "open" "--type" "luks"
                              "--key-file" keyfile
                              partition #$target)))
                 (zero? (system*/tty
                         #$(file-append cryptsetup-static "/sbin/cryptsetup")
                         "open" "--type" "luks"
                         partition #$target)))))))))

(define (close-luks-device source targets)
  "Return a gexp that closes TARGET, a LUKS device."
  (match targets
    ((target)
     #~(zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup")
                       "close" #$target)))))

(define* (check-luks-device md #:key
                            needed-for-boot?
                            (initrd-modules '())
                            #:allow-other-keys
                            #:rest rest)
  "Ensure the source of MD is valid."
  (let ((source   (mapped-device-source md))
        (location (mapped-device-location md)))
    (or (not (zero? (getuid)))
        (if (uuid? source)
            (match (find-partition-by-luks-uuid (uuid-bytevector source))
              (#f
               (raise (make-compound-condition
                       (formatted-message (G_ "no LUKS partition with UUID '~a'")
                                          (uuid->string source))
                       (condition
                        (&error-location
                         (location (source-properties->location
                                    (mapped-device-location md))))))))
              ((? string? device)
               (check-device-initrd-modules device initrd-modules location)))
            (check-device-initrd-modules source initrd-modules location)))))

(define luks-device-mapping
  ;; The type of LUKS mapped devices.
  (mapped-device-kind
   (open open-luks-device)
   (close close-luks-device)
   (check check-luks-device)
   (modules '((rnrs bytevectors)                  ;bytevector?
              ((gnu build file-systems)
               #:select (find-partition-by-luks-uuid system*/tty))))))

(define* (luks-device-mapping-with-options #:key key-file)
  "Return a luks-device-mapping object with open modified to pass the arguments
into the open-luks-device procedure."
  (mapped-device-kind
   (inherit luks-device-mapping)
   (open (λ (source targets) (open-luks-device source targets
                                               #:key-file key-file)))))

(define (open-raid-device sources targets)
  "Return a gexp that assembles SOURCES (a list of devices) to the RAID device
TARGET (e.g., \"/dev/md0\"), using 'mdadm'."
  (match targets
    ((target)
     #~(let ((sources '#$sources)

             ;; XXX: We're not at the top level here.  We could use a
             ;; non-top-level 'use-modules' form but that doesn't work when the
             ;; code is eval'd, like the Shepherd does.
             (every   (@ (srfi srfi-1) every))
             (format  (@ (ice-9 format) format)))
         (let loop ((attempts 0))
           (unless (every file-exists? sources)
             (when (> attempts 20)
               (error "RAID devices did not show up; bailing out"
                      sources))

             (format #t "waiting for RAID source devices~{ ~a~}...~%"
                     sources)
             (sleep 1)
             (loop (+ 1 attempts))))

         ;; Use 'mdadm-static' rather than 'mdadm' to avoid pulling its whole
         ;; closure (80 MiB) in the initrd when a RAID device is needed for boot.
         (zero? (apply system* #$(file-append mdadm-static "/sbin/mdadm")
                       "--assemble" #$target sources))))))

(define (close-raid-device sources targets)
  "Return a gexp that stops the RAID device TARGET."
  (match targets
    ((target)
     #~(zero? (system* #$(file-append mdadm-static "/sbin/mdadm")
                       "--stop" #$target)))))

(define raid-device-mapping
  ;; The type of RAID mapped devices.
  (mapped-device-kind
   (open open-raid-device)
   (close close-raid-device)))

(define (open-lvm-device source targets)
  #~(and
     (zero? (system* #$(file-append lvm2-static "/sbin/lvm")
                     "vgchange" "--activate" "ay" #$source))
     ; /dev/mapper nodes are usually created by udev, but udev may be unavailable at the time we run this. So we create them here.
     (zero? (system* #$(file-append lvm2-static "/sbin/lvm")
                     "vgscan" "--mknodes"))
     (every file-exists? (map (lambda (file) (string-append "/dev/mapper/" file))
                              '#$targets))))


(define (close-lvm-device source targets)
  #~(zero? (system* #$(file-append lvm2-static "/sbin/lvm")
                    "vgchange" "--activate" "n" #$source)))

(define lvm-device-mapping
  (mapped-device-kind
   (open open-lvm-device)
   (close close-lvm-device)
   (modules '((srfi srfi-1)))))

;;; mapped-devices.scm ends here
generated by cgit
span class="nx">prev; return fib(n - 1, prev + prev_prev, prev); } console.log(fib(15));

Assuming it's in sample-script.js, we can do

uglifyjs sample-script.js \
    --beautify \
    "template_for_CALL='(console.log(\"call at line \" + /*line*/), /*expression*//*parented_args*/)'"

it should print

function fib(n, prev = 1, prev_prev = 0) {
    if (n === 0) return prev_prev;
    if (n === 1) return prev;
    return (console.log("call at line " + 8), fib(n - 1, prev + prev_prev, prev));
}

console.log((console.log("call at line " + 11), fib(15)));

As you can see, we used a template to dictate the way UglifyJS outputs function calls. All occurances of /*line*/ /*expression*/, and /*parented_args*/ in a call template get substituted for their respective pieces of code. Template text outside /* and */ delimiters gets printed as is (although changes to the amount of whitespace might occur).

Templates should be specified as options to --beautify (or to --output-opts). They should be given in a form of JavaScript sequence of assignments, e.g. template_for_CALL='something',template_for_PROPERTY_CALL="something-else" (this syntax is also used for other options in the upstream UglifyJS).

There are a few more details. Firstly, each kind of template has its own set of permitted substitutions which includes at least /*line*/, /*col*/ and /**/ (empty substitution). With the above CALL template example we omitted (for brevity) the /*optional*/, /*col*/ and /**/ substitutions. Additionally, the */ delimiter can be replaced with **/ to cause the text immediately after substitution to be ignored until either whitespace or slash / is encountered. This can be used as a hack to write templates that are still syntactically correct JavaScript so that your IDE highlights and indents them correctly. See the included templates for examples.

Also, please keep in mind that the template engine isn't very smart when it comes to strings. If your template includes a string literal with braces or whitespace and you use an output option like max_line_len, things might break. This shouldn't be a problem most of the time, though.

Tracifying code

The templates system allows one to dictate different types of code modifications without having to modify (and possibly repackage, depending on one's workflow) our modified UglifyJS. That's cool but if you're still reading, you probably expect to get some ready-to-use tracing tool, not just an (incomplete) JS expression templating system, right?

The trace-*.js snippets in this repository are what you're looking for. They allow function calls, binary expressions and values used/produced by them to be logged in a variable called simply tracing.

Here are some shell functions useful for passing the snippets to UglifyJS. Note that besides the templates we also specify a preamble — static piece of code to be included at the beginning of the output. Preamble is a feature of upstream UglifyJS.

TRACIFY_DIR="$(pwd)"

function file_as_js_string {
    printf "'%s'" \
           "$(tr '\n' '\034' < "$1" |
                  sed 's/\\/\\\\/g;s/\o034/\\n/g;'"s/'/\\\\'/g;")"
}

function preamble_as_js_string {
    file_as_js_string "$TRACIFY_DIR/trace-preamble.js"
}

function tracify_options {
    printf 'preamble='
    if [ "x" = "${NO_PREAMBLE:+x}" ]; then
        printf "''"
    else
        preamble_as_js_string
    fi

    for TYPE in BINARY LAZY_BINARY CALL PROPERTY_CALL; do
        printf ",template_for_%s=%s" \
               "$TYPE" \
               "$(file_as_js_string \
                      "$TRACIFY_DIR/trace-template-for-$TYPE.js")"
    done
}

function tracify {
    uglifyjs --beautify "$(tracify_options)" "$@"
}

After defining these in your shell, you can do e.g.

tracify sample-script.js > sample-script-tracified.js

If you're evaluating multiple tracified scripts in the same scope, you'll want to only include the preamble in the first one. Using functions above, the rest could be tracified like this

NO_PREAMBLE=omit tracify another-script.js > another-script-tracified.js

Evaluating and inspecting traces

When reverse-engineering some website's logic, you'll most likely run the tracified code in the browser. How you do it is up to you. Pasting it manually, "serving" with Mitmproxy, substituting scripts using some quick and dirty browser extension… Either way, don't forget to update the integrity checksum if they are used :)

Once the code has run, open JavaScript console in the context of that page. You can get the entire trace with

tracing.get_log()

This will be a list of log entry objects, each looking like this

{
​​    op_name: "+"
    line: 8
    column: 22
    ​​id: 71
​​    parent_call: Object { op_name: "call", line: 8, column: 11, … }
​​    left: 377
​​    right: 233
​​    result: 610
}

The left and right properties are of course specific to binary operations. Log entries of function calls will not have these but they will instead have e.g. a function_object property. You get the point.

Feel free to use JavaScript as an aid when inspecting traces

tracing.get_log().filter(op => op.function_object?.name === "jA")

You also get a map of objects (operands, function arguments, results, etc.) to lists of log entries they appear in. You can use it like this

tracing.get_objects().get(610) // How did 610 get produced?

Finally, your particular use case might require changes to the templates. Maybe the script you're RE'ing causes the page to get reloaded and you have no access to the tracing object? You might then want to modify the preamble to send the logs to your server, for example with the beacon API. Maybe the overhead of tracing is too big? Find out if you can limit the tracing to only a subset of expressions and still achieve the goal. Finally, avoiding name clashes with traced code and guarding against redefinitions of well-known properties/functions (think Map.prototype.get = "trololo";) are beyond the scope of this prototype. These should be easy to work around, though, if you're able to replay the browser session somehow.

Copying

Code on this git branch is Copyright 2024 Wojtek Kosior <koszko@koszko.org>, released under the terms of Creative Commons Zero v1.0.

This is public domain software made and released as a gift to the public. You can legally use it any way you want. However, I, the author, kindly request (without legal requirement) that you don't integrate it into any proprietary or otherwise harmful product. Please, make your derivative work free/libre software and a gift to the public as well!