aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012-2021, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2023 Foundation Devices, Inc. <hello@foundationdevices.com>
;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
;;;
;;; 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 (test-utils)
  #:use-module ((guix config) #:select (%gzip))
  #:use-module (guix utils)
  #:use-module ((guix build utils) #:select (call-with-temporary-output-file))
  #:use-module ((guix store) #:select (%store-prefix store-path-package-name))
  #:use-module ((guix search-paths) #:select (string-tokenize*))
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-64)
  #:use-module (rnrs bytevectors)
  #:use-module (rnrs io ports)
  #:use-module (ice-9 match)
  #:use-module (ice-9 vlist))

(define temp-file
  (string-append "t-utils-" (number->string (getpid))))

(test-begin "utils")

(test-assert "gnu-triplet->nix-system"
  (let ((samples '(("i586-gnu0.3" "i686-gnu")
                   ("x86_64-unknown-linux-gnu" "x86_64-linux")
                   ("i386-pc-linux-gnu" "i686-linux")
                   ("x86_64-unknown-freebsd8.2" "x86_64-freebsd")
                   ("x86_64-apple-darwin10.8.0" "x86_64-darwin")
                   ("i686-pc-cygwin" "i686-cygwin"))))
    (let-values (((gnu nix) (unzip2 samples)))
      (every (lambda (gnu nix)
               (equal? nix (gnu-triplet->nix-system gnu)))
             gnu nix))))

(test-assert "package-name->name+version"
  (every (match-lambda
          ((name version)
           (let*-values (((full-name)
                          (if version
                              (string-append name "@" version)
                              name))
                         ((name* version*)
                          (package-name->name+version full-name)))
             (and (equal? name* name)
                  (equal? version* version)))))
         '(("foo" "0.9.1b")
           ("foo-14-bar" "320")
           ("foo-bar2" #f)
           ("guile" "2.0.6.65-134c9") ; as produced by `git-version-gen'
           ("nixpkgs" "1.0pre22125_a28fe19")
           ("gtk2" "2.38.0"))))

(test-assert "guile-version>? 1.8"
  (guile-version>? "1.8"))

(test-assert "guile-version>? 10.5"
  (not (guile-version>? "10.5")))

(test-assert "version-prefix?"
  (and (version-prefix? "4.1" "4.1.2")
       (version-prefix? "4.1" "4.1")
       (not (version-prefix? "4.1" "4.16.2"))
       (not (version-prefix? "4.1" "4"))))

(test-equal "version-unique-prefix"
  '("2" "2.2" "")
  (list (version-unique-prefix "2.0" '("3.0" "2.0"))
        (version-unique-prefix "2.2" '("3.0.5" "2.0.9" "2.2.7"))
        (version-unique-prefix "27.1" '("27.1"))))

(test-equal "string-tokenize*"
  '(("foo")
    ("foo" "bar" "baz")
    ("foo" "bar" "")
    ("foo" "bar" "baz"))
  (list (string-tokenize* "foo" ":")
        (string-tokenize* "foo;bar;baz" ";")
        (string-tokenize* "foo!bar!" "!")
        (string-tokenize* "foo+-+bar+-+baz" "+-+")))

(test-equal "string-replace-substring"
  '("foo BAR! baz"
    "/gnu/store/chbouib"
    "")
  (list (string-replace-substring "foo bar baz" "bar" "BAR!")
        (string-replace-substring "/nix/store/chbouib" "/nix/" "/gnu/")
        (string-replace-substring "" "foo" "bar")))

(test-equal "strip-keyword-arguments"
  '(a #:b b #:c c)
  (strip-keyword-arguments '(#:foo #:bar #:baz)
                           '(a #:foo 42 #:b b #:baz 3
                               #:c c #:bar 4)))

(test-equal "ensure-keyword-arguments"
  '((#:foo 2)
    (#:foo 2 #:bar 3)
    (#:foo 42 #:bar 3))
  (list (ensure-keyword-arguments '(#:foo 2) '(#:foo 2))
        (ensure-keyword-arguments '(#:foo 2) '(#:bar 3))
        (ensure-keyword-arguments '(#:foo 2) '(#:bar 3 #:foo 42))))

(test-equal "default-keyword-arguments"
  '((#:foo 2)
    (#:foo 2)
    (#:foo 2 #:bar 3)
    (#:foo 2 #:bar 3)
    (#:foo 2 #:bar 3))
  (list (default-keyword-arguments '() '(#:foo 2))
        (default-keyword-arguments '(#:foo 2) '(#:foo 4))
        (default-keyword-arguments '() '(#:bar 3 #:foo 2))
        (default-keyword-arguments '(#:bar 3) '(#:foo 2))
        (default-keyword-arguments '(#:foo 2 #:bar 3) '(#:bar 6))))

(test-equal "substitute-keyword-arguments"
  '((#:foo 3)
    (#:foo 3)
    (#:foo 3 #:bar (1 2))
    (#:bar (1 2) #:foo 3)
    (#:foo 3))
  (list (substitute-keyword-arguments '(#:foo 2)
          ((#:foo f) (1+ f)))
        (substitute-keyword-arguments '()
          ((#:foo f 2) (1+ f)))
        (substitute-keyword-arguments '(#:foo 2 #:bar (2))
          ((#:foo f) (1+ f))
          ((#:bar b) (cons 1 b)))
        (substitute-keyword-arguments '(#:foo 2)
          ((#:foo _) 3)
          ((#:bar b '(2)) (cons 1 b)))
        (substitute-keyword-arguments '(#:foo 2)
          ((#:foo f 1) (1+ f))
          ((#:bar b) (cons 42 b)))))

(test-assert "filtered-port, file"
  (let* ((file  (search-path %load-path "guix.scm"))
         (input (open-file file "r0b")))
    (let*-values (((compressed pids1)
                   (filtered-port `(,%gzip "-c" "--fast") input))
                  ((decompressed pids2)
                   (filtered-port `(,%gzip "-d") compressed)))
      (and (every (compose zero? cdr waitpid)
                  (append pids1 pids2))
           (equal? (get-bytevector-all decompressed)
                   (call-with-input-file file get-bytevector-all))))))

(test-assert "filtered-port, non-file"
  (let ((data (call-with-input-file (search-path %load-path "guix.scm")
                get-bytevector-all)))
    (let*-values (((compressed pids1)
                   (filtered-port `(,%gzip "-c" "--fast")
                                  (open-bytevector-input-port data)))
                  ((decompressed pids2)
                   (filtered-port `(,%gzip "-d") compressed)))
      (and (pk (every (compose zero? cdr waitpid)
                   (append pids1 pids2)))
           (equal? (get-bytevector-all decompressed) data)))))

(test-assert "filtered-port, does not exist"
  (let* ((file  (search-path %load-path "guix.scm"))
         (input (open-file file "r0b")))
    (let-values (((port pids)
                  (filtered-port '("/does/not/exist") input)))
      (any (compose (negate zero?) cdr waitpid)
           pids))))

(define (test-compression/decompression method run?)
  "Test METHOD, a symbol such as 'gzip.  Call RUN? to determine whether to
skip these tests."
  (unless (run?) (test-skip 1))
  (test-assert (format #f "compressed-port, decompressed-port, non-file [~a]"
                       method)
    (let ((data (call-with-input-file (search-path %load-path "guix.scm")
                  get-bytevector-all)))
      (call-with-temporary-output-file
       (lambda (output port)
         (close-port port)
         (let*-values (((compressed pids)
                        ;; Note: 'compressed-output-port' only supports file
                        ;; ports.
                        (compressed-output-port method
                                                (open-file output "w0"))))
           (put-bytevector compressed data)
           (close-port compressed)
           (and (every (compose zero? cdr waitpid)
                       (pk 'pids method pids))
                (let*-values (((decompressed pids)
                               (decompressed-port method
                                                  (open-bytevector-input-port
                                                   (call-with-input-file output
                                                     get-bytevector-all))))
                              ((result)
                               (get-bytevector-all decompressed)))
                  (close-port decompressed)
                  (pk 'len method
                      (if (bytevector? result)
                          (bytevector-length result)
                          result)
                      (bytevector-length data))
                  (and (every (compose zero? cdr waitpid)
                              (pk 'pids method pids))
                       (equal? result data)))))))))

  (false-if-exception (delete-file temp-file))
  (unless (run?) (test-skip 1))
  (test-assert (format #f "compressed-output-port + decompressed-port [~a]"
                       method)
    (let* ((file (search-path %load-path "guix/derivations.scm"))
           (data (call-with-input-file file get-bytevector-all))
           (port (open-file temp-file "w0b")))
      (call-with-compressed-output-port method port
        (lambda (compressed)
          (put-bytevector compressed data)))
      (close-port port)

      (bytevector=? data
                    (call-with-decompressed-port method (open-file temp-file "r0b")
                      get-bytevector-all)))))

(for-each test-compression/decompression
          `(gzip xz lzip zstd)
          (list (const #t) (const #t) (const #t)
                (lambda ()
                  (resolve-module '(zstd) #t #f #:ensure #f))))

;; This is actually in (guix store).
(test-equal "store-path-package-name"
  "bash-4.2-p24"
  (store-path-package-name
   (string-append (%store-prefix)
                  "/qvs2rj2ia5vci3wsdb7qvydrmacig4pg-bash-4.2-p24")))

(test-equal "canonical-newline-port"
  "This is a journey\nInto the sound\nA journey ...\n"
  (let ((port (open-string-input-port
               "This is a journey\r\nInto the sound\r\nA journey ...\n")))
    (get-string-all (canonical-newline-port port))))

(test-equal "canonical-newline-port-1024"
  (string-concatenate (make-list 100 "0123456789abcde\n"))
  (let ((port (open-string-input-port
               (string-concatenate
                (make-list 100 "0123456789abcde\r\n")))))
    (get-string-all (canonical-newline-port port))))

(test-equal "edit-expression"
  "(display \"GNU Guix\")\n(newline)\n"
  (begin
    (call-with-output-file temp-file
      (lambda (port)
        (display "(display \"xiuG UNG\")\n(newline)\n" port)))
    (edit-expression `((filename . ,temp-file)
                       (line     . 0)
                       (column   . 9))
                     string-reverse)
    (call-with-input-file temp-file get-string-all)))

(test-equal "insert-expression"
  "(define-public package-1\n  'package)\n
(define-public package-2\n  'package)\n"
  (begin
    (call-with-output-file temp-file
      (lambda (port)
        (display "(define-public package-2\n  'package)\n" port)))
    (insert-expression `((filename . ,temp-file)
                         (line     . 0)
                         (column   . 0))
                       `(define-public package-1 'package))
    (call-with-input-file temp-file get-string-all)))

(test-equal "find-definition-insertion-location"
  (list `((filename . ,temp-file) (line . 0) (column . 0))
        `((filename . ,temp-file) (line . 5) (column . 0))
        #f)
  (begin
    (call-with-output-file temp-file
      (lambda (port)
        (display "(define-public package-1\n  'foo)\n\n" port)
        (display "(define foo 'bar)\n\n" port)
        (display "(define-public package-2\n  'baz)\n" port)))
    (map (lambda (term)
           (find-definition-insertion-location temp-file term))
         (list 'package 'package-1 'package-2))))

(test-equal "string-distance"
  '(0 1 1 5 5)
  (list
   (string-distance "hello" "hello")
   (string-distance "hello" "helo")
   (string-distance "helo" "hello")
   (string-distance "" "hello")
   (string-distance "hello" "")))

(test-equal "string-closest"
  '("hello" "hello" "helo" #f)
  (list
   (string-closest "hello" '("hello"))
   (string-closest "hello" '("helo" "hello" "halo"))
   (string-closest "hello" '("kikoo" "helo" "hihihi" "halo"))
   (string-closest "hello" '("aaaaa" "12345" "hellohello" "h"))))

(test-equal "target-linux?"
  '(#t #f #f #t)
  (map target-linux?
       '("i686-linux-gnu" "i686-w64-mingw32"
         ;; Checking that "gnu" is present is not sufficient,
         ;; as GNU/Hurd exists.
         "i686-pc-gnu"
         ;; Some targets have a suffix.
         "arm-linux-gnueabihf")))

(test-equal "target-mingw?"
  '(#f #f #t)
  (map target-mingw?
       '("i686-linux-gnu" "i686-pc-gnu"
         "i686-w64-mingw32")))

(test-equal "target-x86-32?"
  '(#f #f #f #t #t #t #t #f)
  ;; These are (according to Wikipedia) two RISC architectures
  ;; by Intel and presumably not compatible with the x86-32 series.
  (map target-x86-32?
       '("i860-gnu" "i960-gnu"
         ;; This is a 16-bit architecture
         "i286-gnu"
         ;; These are part of the x86-32 series.
         "i386-gnu" "i486-gnu" "i586-gnu" "i686-gnu"
         ;; Maybe this one will exist some day, but not yet.
         "i786-gnu")))

(test-equal "target-x86-64?"
  '(#t #f #f #f)
  (map target-x86-64?
       `("x86_64-linux-gnu" "i386-linux-gnu"
         ;; Just because it includes "64" doesn't make it 64-bit.
         "aarch64-linux-gnu"
         ;; Note that (expt 2 109) in decimal notation starts with 64.
         ;; However, it isn't 32-bit.
         ,(format #f "x86_~a-linux-gnu" (expt 2 109)))))

(test-equal "target-avr?"
  '(#t #t #t #f #f)
  (map target-avr?
       '("avr" "avr-unknown-none"
         ;; In addition LLVM also uses this form.
         "avr-unknown-unknown"
         ;; The AVR32 architecture also was made by Atmel/Microchip but it
         ;; does not resemble the AVR family, they aren't compatible in any
         ;; way.
         "avr32" "avr32-unknown-none")))

(test-end)

(false-if-exception (delete-file temp-file))
generated by cgit
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!