<commit_before>#lang racket/base
(require racket/cmdline
         racket/file
         racket/port
         racket/string
         racket/list
         racket/path
         file/zip
         openssl/sha1
         net/url
         pkg/strip
         pkg/lib
         setup/getinfo)

(module test racket/base)

(define pack-dest-dir #f)
(define catalog-dirs null)
(define native? #f)
(define relative? #t)
(define get-modules? #f)
(define checksum-dir #f)
(define source-checksums? #f)

(define src-dirs
  (command-line
   #:once-each
   [("--pack") dest-dir "Pack to <dest-dir>"
    (set! pack-dest-dir dest-dir)]
   [("--native") "Pack as native"
    (set! native? #t)]
   [("--absolute") "Record paths as absolute"
    (set! relative? #f)]
   [("--source-checksum") "Compute checksum from source when not packing"
    (set! source-checksums? #t)]
   [("--at-checksum") dir "Copy each to to <dir>/<checksum>"
    (set! checksum-dir dir)]
   [("--mods") "Include modules and dependencies in catalog"
    (set! get-modules? #t)]
   #:multi
   [("++catalog") catalog-dir "Write catalog entry to <catalog-dir>"
    (set! catalog-dirs (cons catalog-dir catalog-dirs))]
   #:args
   pkgs-dir
   pkgs-dir))

(when pack-dest-dir
  (make-directory* pack-dest-dir))
(for ([catalog-dir (in-list catalog-dirs)])
  (make-directory* catalog-dir))

(define metadata-ns (make-base-namespace))

(define (stream-directory d)
  (define-values (i o) (make-pipe (* 100 4096)))
  (define (skip-path? p)
    (let-values ([(base name dir?) (split-path p)])
      (define s (path->string name))
      (or (member s '("compiled"))
          (regexp-match? #rx#"^(?:[.]git.*|[.]svn|.*~|#.*#)$" s))))
  (thread (lambda ()
            (let loop ([d d])
              (for ([f (directory-list d #:build? #t)])
                (cond
                 [(skip-path? f) (void)]
                 [(directory-exists? f)
                  (write (filter-not skip-path? (directory-list f)) o)
                  (loop f)]
                 [(file-exists? f)
                  (call-with-input-file* 
                   f
                   (lambda (i) (copy-port i o)))])))
            (close-output-port o)))
  i)

(define (do-package src-dir pkg-name)
  (define zip-file (path-add-suffix pkg-name #".zip"))
  (define dest-zip (and pack-dest-dir
                        (build-path (path->complete-path pack-dest-dir) 
                                    zip-file)))

  (define pkg-src-dir (build-path src-dir pkg-name))

  (when pack-dest-dir
    (define sum-file (path-add-suffix pkg-name #".srcsum"))
    (printf "summing ~a\n" pkg-src-dir)
    (define src-sha1 (sha1 (stream-directory pkg-src-dir)))
    (define dest-sum (build-path (path->complete-path pack-dest-dir) sum-file))
    (unless (and (file-exists? dest-zip)
                 (file-exists? dest-sum)
                 (equal? (list (version) src-sha1)
                         (call-with-input-file* dest-sum read)))
      (printf "packing ~a\n" zip-file)
      (define tmp-dir (make-temporary-file "~a-pkg" 'directory))
      (parameterize ([strip-binary-compile-info #f]) ; for deterministic checksum
        (generate-stripped-directory (if native? 'binary 'source)
                                     pkg-src-dir 
                                     tmp-dir))
      (parameterize ([current-directory tmp-dir])
        (when (file-exists? dest-zip) (delete-file dest-zip))
        (apply zip dest-zip (directory-list)
               ;; Use a constant timestamp so that the checksum does
               ;; not depend on timestamps:
               #:timestamp 1359788400
               #:system-type 'unix))
      (delete-directory/files tmp-dir)
      (call-with-output-file*
       dest-sum
       #:exists 'truncate/replace
       (lambda (o)
         (write (list (version) src-sha1) o)
         (newline o)))))

  (define info-path (build-path src-dir pkg-name))
  (define i (get-info/full info-path))
  (define (get key)
    (i key (lambda ()
             (error 'catalog-local
                    "missing `~a'\n  path: ~a"
                    key<commit_msg>distro-build: create ".zip" files with timestamps as UTC<commit_after>#lang racket/base
(require racket/cmdline
         racket/file
         racket/port
         racket/string
         racket/list
         racket/path
         file/zip
         openssl/sha1
         net/url
         pkg/strip
         pkg/lib
         setup/getinfo)

(module test racket/base)

(define pack-dest-dir #f)
(define catalog-dirs null)
(define native? #f)
(define relative? #t)
(define get-modules? #f)
(define checksum-dir #f)
(define source-checksums? #f)

(define src-dirs
  (command-line
   #:once-each
   [("--pack") dest-dir "Pack to <dest-dir>"
    (set! pack-dest-dir dest-dir)]
   [("--native") "Pack as native"
    (set! native? #t)]
   [("--absolute") "Record paths as absolute"
    (set! relative? #f)]
   [("--source-checksum") "Compute checksum from source when not packing"
    (set! source-checksums? #t)]
   [("--at-checksum") dir "Copy each to to <dir>/<checksum>"
    (set! checksum-dir dir)]
   [("--mods") "Include modules and dependencies in catalog"
    (set! get-modules? #t)]
   #:multi
   [("++catalog") catalog-dir "Write catalog entry to <catalog-dir>"
    (set! catalog-dirs (cons catalog-dir catalog-dirs))]
   #:args
   pkgs-dir
   pkgs-dir))

(when pack-dest-dir
  (make-directory* pack-dest-dir))
(for ([catalog-dir (in-list catalog-dirs)])
  (make-directory* catalog-dir))

(define metadata-ns (make-base-namespace))

(define (stream-directory d)
  (define-values (i o) (make-pipe (* 100 4096)))
  (define (skip-path? p)
    (let-values ([(base name dir?) (split-path p)])
      (define s (path->string name))
      (or (member s '("compiled"))
          (regexp-match? #rx#"^(?:[.]git.*|[.]svn|.*~|#.*#)$" s))))
  (thread (lambda ()
            (let loop ([d d])
              (for ([f (directory-list d #:build? #t)])
                (cond
                 [(skip-path? f) (void)]
                 [(directory-exists? f)
                  (write (filter-not skip-path? (directory-list f)) o)
                  (loop f)]
                 [(file-exists? f)
                  (call-with-input-file* 
                   f
                   (lambda (i) (copy-port i o)))])))
            (close-output-port o)))
  i)

(define (do-package src-dir pkg-name)
  (define zip-file (path-add-suffix pkg-name #".zip"))
  (define dest-zip (and pack-dest-dir
                        (build-path (path->complete-path pack-dest-dir) 
                                    zip-file)))

  (define pkg-src-dir (build-path src-dir pkg-name))

  (when pack-dest-dir
    (define sum-file (path-add-suffix pkg-name #".srcsum"))
    (printf "summing ~a\n" pkg-src-dir)
    (define src-sha1 (sha1 (stream-directory pkg-src-dir)))
    (define dest-sum (build-path (path->complete-path pack-dest-dir) sum-file))
    (unless (and (file-exists? dest-zip)
                 (file-exists? dest-sum)
                 (equal? (list (version) src-sha1)
                         (call-with-input-file* dest-sum read)))
      (printf "packing ~a\n" zip-file)
      (define tmp-dir (make-temporary-file "~a-pkg" 'directory))
      (parameterize ([strip-binary-compile-info #f]) ; for deterministic checksum
        (generate-stripped-directory (if native? 'binary 'source)
                                     pkg-src-dir 
                                     tmp-dir))
      (parameterize ([current-directory tmp-dir])
        (when (file-exists? dest-zip) (delete-file dest-zip))
        (apply zip dest-zip (directory-list)
               ;; Use a constant timestamp so that the checksum does
               ;; not depend on timestamps:
               #:timestamp 1359788400
               #:utc-timestamps? #t
               #:system-type 'unix))
      (delete-directory/files tmp-dir)
      (call-with-output-file*
       dest-sum
       #:exists 'truncate/replace
       (lambda (o)
         (write (list (version) src-sha1) o)
         (newline o)))))

  (define info-path (build-path src-dir pkg-name))
  (define i (get-info/full info-path))
  (define (get key)
    (i key (lambda ()
             (error 'catalog-local
                    "missing `~a'\n  path: ~a"
                    key
{'fraction_non_alphanumeric': 0.15725172372081772, 'fraction_numerical': 0.005322366033627676, 'mean_word_length': 1.9549678341672623, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 17, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1371776', 'n_tokens_mistral': 2779, 'n_tokens_neox': 2631, 'n_words': 684}