113 lines
4.5 KiB
Racket
113 lines
4.5 KiB
Racket
|
#!/usr/bin/env racket
|
||
|
#lang racket
|
||
|
(require net/url
|
||
|
json
|
||
|
(prefix-in pack: "src/pack.rkt"))
|
||
|
|
||
|
(provide mod
|
||
|
mod/cf)
|
||
|
|
||
|
(current-print void)
|
||
|
(define do-clean (make-parameter #f))
|
||
|
(command-line #:program "build.rkt"
|
||
|
#:once-any [("-c" "--clean") "Delete build output instead of building"
|
||
|
(do-clean #t)])
|
||
|
|
||
|
;; This is the API key used by the CurseForge launcher.
|
||
|
;; Fuck you, CurseForge!
|
||
|
(define cf-launcher-api-key "$2a$10$bL4bIL5pUWqfcO7KQtnMReakwtfHbNKh6v1uTpKlzhwoueEJQnPnm")
|
||
|
|
||
|
;; TODO: Find a HTTP lib for racket that works with CF's broken URL encoding implementation
|
||
|
(define download-urls
|
||
|
(match (find-executable-path "aria2c")
|
||
|
[#f (match (find-executable-path "wget")
|
||
|
[#f (raise-user-error "WGet or Aria2 is required!")]
|
||
|
[wget-exe (λ (urls) (parameterize ([current-directory mods-dir])
|
||
|
(apply system* #:set-pwd? #t wget-exe "--no-verbose" urls)))])]
|
||
|
[aria-exe
|
||
|
(λ (urls)
|
||
|
(parameterize ([current-directory mods-dir])
|
||
|
(match-let ([(list #f #f _ #f control)
|
||
|
(process*/ports (current-output-port)
|
||
|
(open-input-string (string-join urls "\n"))
|
||
|
(current-error-port)
|
||
|
#:set-pwd? #t
|
||
|
aria-exe
|
||
|
;; CF idiotically thinks they can block aria2 by detecting this header.
|
||
|
"--no-want-digest-header"
|
||
|
"--auto-file-renaming" "false"
|
||
|
"--allow-overwrite" "true"
|
||
|
"-i" "-"
|
||
|
"-j" "8")])
|
||
|
(control 'wait))))]))
|
||
|
|
||
|
;; Mods are collected in this list.
|
||
|
(define mods '())
|
||
|
|
||
|
(define (mod url)
|
||
|
(set! mods (cons url mods)))
|
||
|
|
||
|
(define (mod/cf pid fid)
|
||
|
(printf "resolve CF: ~a:~a\n" pid fid)
|
||
|
(let* ([url (string->url (format "https://api.curseforge.com/v1/mods/~a/files/~a/download-url" pid fid))]
|
||
|
[response (call/input-url url get-pure-port read-json (list (format "x-api-key: ~a" cf-launcher-api-key)))]
|
||
|
[mod-url (hash-ref response 'data)])
|
||
|
(mod mod-url)))
|
||
|
|
||
|
|
||
|
(define build-dir (build-path "build" pack:name))
|
||
|
(when (do-clean)
|
||
|
(when (directory-exists? build-dir)
|
||
|
(delete-directory/files build-dir))
|
||
|
(exit))
|
||
|
|
||
|
(define mods-dir (build-path build-dir "minecraft" "mods"))
|
||
|
(make-directory* mods-dir)
|
||
|
|
||
|
(displayln "creating manifests")
|
||
|
(with-output-to-file (build-path build-dir "instance.cfg") #:exists 'truncate/replace
|
||
|
(λ ()
|
||
|
(displayln "InstanceType=OneSix")
|
||
|
(printf "name=~a\n" pack:name)
|
||
|
(printf "ManagedPackName=~a\n" pack:name)
|
||
|
(printf "ManagedPackVersionName=~a\n" pack:version)))
|
||
|
|
||
|
(let* ([components
|
||
|
(list #hasheq((cachedName . "LWJGL 3")
|
||
|
(cachedVersion . "3.2.2")
|
||
|
(version . "3.2.2")
|
||
|
(cachedVolatile . #t)
|
||
|
(dependencyOnly . #t)
|
||
|
(uid . "org.lwjgl3"))
|
||
|
(hasheq 'cachedName "Minecraft"
|
||
|
'cachedRequires '(#hasheq((suggests . "3.2.2")
|
||
|
(uid . "org.lwjgl3")))
|
||
|
'uid "net.minecraft"
|
||
|
'cachedVersion pack:mc-version
|
||
|
'version pack:mc-version
|
||
|
'important #t)
|
||
|
(hasheq 'cachedName "Forge"
|
||
|
'cachedRequires (list (hasheq 'uid "net.minecraft"
|
||
|
'equals pack:mc-version))
|
||
|
'uid "net.minecraftforge"
|
||
|
'cachedVersion pack:forge-version
|
||
|
'version pack:forge-version))]
|
||
|
[manifest (hasheq 'components components 'formatVersion 1)])
|
||
|
(with-output-to-file (build-path build-dir "mmc-pack.json") #:exists 'truncate/replace
|
||
|
(λ () (write-json manifest))))
|
||
|
|
||
|
(pack:mods)
|
||
|
(printf "=== downloading the following URLs ===\n")
|
||
|
(pretty-print mods)
|
||
|
(download-urls mods)
|
||
|
|
||
|
(displayln "installing overrides")
|
||
|
(let loop ([src "src/overrides"] [dest (build-path build-dir "minecraft")])
|
||
|
(cond [(directory-exists? src)
|
||
|
(unless (directory-exists? dest) (make-directory dest))
|
||
|
(for ([subp (directory-list src)])
|
||
|
(loop (build-path src subp) (build-path dest subp)))]
|
||
|
[(file-exists? src)
|
||
|
(copy-file src dest #:exists-ok? #t)]))
|
||
|
|