Browse Source

Update all types to be compatible with Cakelisp

See Cakelisp a1e022e6d5.
master
Macoy Madson 1 year ago
parent
commit
90abbc4fe0
  1. 96
      src/Allocator.cake
  2. 18
      src/Aubio.cake
  3. 12
      src/AutoTest.cake
  4. 76
      src/AutoUpdate.cake
  5. 34
      src/AutoUpdateApplication.cake
  6. 14
      src/Compression.cake
  7. 12
      src/Config_ZigCompile.cake
  8. 68
      src/Cryptography.cake
  9. 66
      src/CryptographyCLI.cake
  10. 34
      src/Curl.cake
  11. 88
      src/DataBundle.cake
  12. 12
      src/Dependencies.cake
  13. 214
      src/Dictionary.cake
  14. 146
      src/DynamicArray.cake
  15. 94
      src/FileSystem.cake
  16. 20
      src/FreeType.cake
  17. 6
      src/Hash.cake
  18. 44
      src/ImGui.cake
  19. 28
      src/ImGuiAutoColor.cake
  20. 6
      src/Image.cake
  21. 670
      src/Introspection.cake
  22. 70
      src/Licenses.cake
  23. 4
      src/Math.cake
  24. 4
      src/Network.cake
  25. 90
      src/Ogre.cake
  26. 34
      src/OgreInitialize.cake
  27. 50
      src/Oniguruma.cake
  28. 46
      src/OpenGL.cake
  29. 10
      src/OpenSSL.cake
  30. 30
      src/ProfilerAutoInstrument.cake
  31. 4
      src/Raylib.cake
  32. 124
      src/SDL.cake
  33. 216
      src/TaskSystem.cake
  34. 24
      src/TinyCCompiler.cake
  35. 6
      src/Tracy.cake
  36. 46
      src/VersionedData.cake
  37. 60
      src/XML.cake
  38. 8
      test/src/GameLibTests.cake

96
src/Allocator.cake

@ -15,20 +15,20 @@
(defstruct block-allocation
size size_t
capacity size_t
data (* (unsigned char)))
data (addr (unsigned char)))
(defun block-allocation-create (size size_t &return (* block-allocation))
(defun block-allocation-create (size size_t &return (addr block-allocation))
;; Create the header alongside the block so it can all go away in one free
(var-cast-to new-block (* block-allocation) (malloc (+ size (sizeof (type block-allocation)))))
(var-cast-to new-block (addr block-allocation) (malloc (+ size (sizeof (type block-allocation)))))
(unless new-block
(allocate-failure "System malloc failed. System out of memory?")
(return null))
(set (path new-block > size) 0)
(set (path new-block > capacity) size)
(set (path new-block > data) (type-cast (+ new-block 1) (* (unsigned char))))
(set (path new-block > data) (type-cast (+ new-block 1) (addr (unsigned char))))
(return new-block))
(defun block-allocation-free (block (* block-allocation))
(defun block-allocation-free (block (addr block-allocation))
(free block))
;;
@ -36,7 +36,7 @@
;;
;; Unaligned!
(defun linear-allocate (block (* block-allocation) size size_t &return (* void))
(defun linear-allocate (block (addr block-allocation) size size_t &return (addr void))
(unless (and block (path block > data))
(allocate-failure "block allocation was not initialized")
(return null))
@ -45,11 +45,11 @@
(allocate-failure "failed to allocate: not enough capacity for requested size")
(return null))
(var-cast-to start (* void) (+ (path block > data) (path block > size)))
(var-cast-to start (addr void) (+ (path block > data) (path block > size)))
(set (path block > size) (+ (path block > size) size))
(return start))
(defun linear-allocate-clear (block (* block-allocation))
(defun linear-allocate-clear (block (addr block-allocation))
(when block
(set (path block > size) 0)))
@ -76,24 +76,24 @@
;; freeing the chain starting from there.
;; You need to copy the root and free from that so that the parent chain's block size isn't changed.
;; Example:
;; (var chain-root (* chain-allocation) (chain-allocation-create 1024))
;; (var chain-root (addr chain-allocation) (chain-allocation-create 1024))
;; ;; Your program does a bunch of allocations on chain-root, then passes in last-chain-link
;; (var stack-before-my-operation chain-allocation (deref last-chain-link)) ;; Copy it to save the capacity
;; (var my-stack-allocator-root chain-allocation last-chain-link)
;; (var working-allocator (* chain-allocation) last-chain-link)
;; (var my-thing (* thing) (chain-allocate-aligned (addr working-allocator)
;; (var working-allocator (addr chain-allocation) last-chain-link)
;; (var my-thing (addr thing) (chain-allocate-aligned (addr working-allocator)
;; (sizeof thing) (alignof thing)))
;; ;; All done, "pop" from our stack and reset the capacity
;; (chain-allocation-free my-stack-allocator-root)
;; (set (deref last-chain-link) stack-before-my-operation)
(defstruct chain-allocation
next-link (* chain-allocation)
next-link (addr chain-allocation)
new-block-size size_t
block block-allocation)
(defun chain-allocation-create (new-block-size size_t &return (* chain-allocation))
(defun chain-allocation-create (new-block-size size_t &return (addr chain-allocation))
;; Create the header alongside the block so it can all go away in one free
(var-cast-to new-chain (* chain-allocation)
(var-cast-to new-chain (addr chain-allocation)
(malloc (+ new-block-size (sizeof (type chain-allocation)))))
(unless new-chain
(allocate-failure "System malloc failed. System out of memory?")
@ -102,28 +102,28 @@
(set (path new-chain > new-block-size) new-block-size)
(set (path new-chain > block . size) 0)
(set (path new-chain > block . capacity) new-block-size)
(set (path new-chain > block . data) (type-cast (+ new-chain 1) (* (unsigned char))))
(set (path new-chain > block . data) (type-cast (+ new-chain 1) (addr (unsigned char))))
(return new-chain))
(defmacro each-link-in-chain-allocator (root any current-link-name symbol next-link-name symbol
&rest body any)
(tokenize-push output
(var (token-splice next-link-name) (* chain-allocation)
(var (token-splice next-link-name) (addr chain-allocation)
(token-splice root))
(while (token-splice next-link-name)
(var (token-splice current-link-name) (* chain-allocation) (token-splice next-link-name))
(var (token-splice current-link-name) (addr chain-allocation) (token-splice next-link-name))
(set (token-splice next-link-name) (path (token-splice current-link-name) > next-link))
(token-splice-rest body tokens)))
(return true))
;; Must pass in the first block, not the final chain pointer!
(defun chain-allocation-free (root (* chain-allocation))
(defun chain-allocation-free (root (addr chain-allocation))
(each-link-in-chain-allocator root current-link next-link
(free current-link)))
(defun-local chain-allocate-new-link (last-link-in-chain-in-out (* (* chain-allocation))
(defun-local chain-allocate-new-link (last-link-in-chain-in-out (addr (addr chain-allocation))
requested-size size_t)
(var current-link (* chain-allocation) (deref last-link-in-chain-in-out))
(var current-link (addr chain-allocation) (deref last-link-in-chain-in-out))
;; If the requested size is less than the chain has been allocating, use the chain size to
;; minimize allocations. If the size is larger, use that, and be fine having a chain with blocks
@ -133,18 +133,18 @@
(var requested-block-size size_t chain-block-size)
(when (> requested-size chain-block-size)
(set requested-block-size requested-size))
(var new-link (* chain-allocation) (chain-allocation-create requested-block-size))
(var new-link (addr chain-allocation) (chain-allocation-create requested-block-size))
(set (path current-link > next-link) new-link)
(set (deref last-link-in-chain-in-out) new-link))
;; You must pass in the address of chain because the chain may be extended
(defun-local chain-allocate-internal (last-link-in-chain-in-out (* (* chain-allocation))
(defun-local chain-allocate-internal (last-link-in-chain-in-out (addr (addr chain-allocation))
requested-size size_t
&return (* void))
(var current-link (* chain-allocation) (deref last-link-in-chain-in-out))
&return (addr void))
(var current-link (addr chain-allocation) (deref last-link-in-chain-in-out))
(assert (and (not (path current-link > next-link))
"chain-allocate-internal called with link that is not the last link in the chain."))
(var memory (* void) null)
(var memory (addr void) null)
;; Enough room in this link?
(when (<= requested-size (- (path current-link > block . capacity)
(path current-link > block . size)))
@ -156,20 +156,20 @@
;; Use for streams of bytes and strings. Do not use for structs or data larger than byte alignment,
;; or performance will suffer.
(defun chain-allocate-unaligned (last-link-in-chain-in-out (* (* chain-allocation)) size size_t
&return (* void))
(defun chain-allocate-unaligned (last-link-in-chain-in-out (addr (addr chain-allocation)) size size_t
&return (addr void))
(return (chain-allocate-internal last-link-in-chain-in-out size)))
;; Use for structured data
(defun chain-allocate-aligned (last-link-in-chain-in-out (* (* chain-allocation)) size size_t
(defun chain-allocate-aligned (last-link-in-chain-in-out (addr (addr chain-allocation)) size size_t
alignment (unsigned int)
&return (* void))
&return (addr void))
;; Used to goto back to the free space alignment when we need a new block
(each-in-range 2 num-passes
;; Eat up some extra bytes to ensure alignment
(var current-block (* block-allocation) (addr (path (deref last-link-in-chain-in-out) > block)))
(var next-free-memory (* (const (unsigned char))) (+ (path current-block > data)
(path current-block > size)))
(var current-block (addr block-allocation) (addr (path (deref last-link-in-chain-in-out) > block)))
(var next-free-memory (addr (const (unsigned char))) (+ (path current-block > data)
(path current-block > size)))
(var-cast-to throwaway-bytes uintptr_t
(- alignment
(mod (type-cast (+ next-free-memory alignment) uintptr_t)
@ -181,10 +181,10 @@
(if (<= total-size-to-request (- (path current-block > capacity)
(path current-block > size)))
(scope ;; Enough space. Allocate it!
(var-cast-to space-before-alignment (* (unsigned char))
(var-cast-to space-before-alignment (addr (unsigned char))
(chain-allocate-internal last-link-in-chain-in-out
total-size-to-request))
(return (type-cast (+ space-before-alignment throwaway-bytes) (* void))))
(return (type-cast (+ space-before-alignment throwaway-bytes) (addr void))))
(scope ;; Need a new block. We need to allocate the new block and re-compute alignment.
;; Our data is going to start immediately after the block header. Let's make sure we request
;; enough memory to do our alignment, assuming the block header is completely unaligned and a
@ -203,13 +203,13 @@
(token-splice chain)
(* (token-splice count) (sizeof (type (token-splice type))))
(alignof (type (token-splice type))))
(* (token-splice type))))
(addr (token-splice type))))
(tokenize-push output
(type-cast (chain-allocate-aligned
(token-splice chain)
(sizeof (type (token-splice type)))
(alignof (type (token-splice type))))
(* (token-splice type)))))
(addr (token-splice type)))))
(return true))
;;
@ -237,13 +237,13 @@
('auto-test
(defun test--allocators (&return int)
(scope
(var block (* block-allocation) (block-allocation-create 1024))
(var block (addr block-allocation) (block-allocation-create 1024))
(unless (and block (path block > data))
(fprintf stderr "Failed to allocate a block\n")
(return 1))
(scope
(var fail-item (* void) (linear-allocate block 1025))
(var fail-item (addr void) (linear-allocate block 1025))
(when fail-item
(fprintf stderr "Expected to fail to allocate, but it succeeded\n")
(block-allocation-free block)
@ -251,14 +251,14 @@
(scope
;; Linear allocate
(var succeed-item (* void) (linear-allocate block 1024))
(var succeed-item (addr void) (linear-allocate block 1024))
(unless succeed-item
(fprintf stderr "Expected to successfully allocate, but it failed\n")
(block-allocation-free block)
(return 1))
(fprintf stderr "Address of block: %p\nAddress of item: %p\n" block succeed-item)
;; Linear allocate from a full block (fail)
(var fail-item (* void) (linear-allocate block 1))
(var fail-item (addr void) (linear-allocate block 1))
(when fail-item
(fprintf stderr "Expected to fail to allocate, but it succeeded\n")
(block-allocation-free block)
@ -273,8 +273,8 @@
(block-allocation-free block))
(scope ;; Chain allocator
(var chain-root (* chain-allocation) (chain-allocation-create 64))
(var chain (* chain-allocation) chain-root)
(var chain-root (addr chain-allocation) (chain-allocation-create 64))
(var chain (addr chain-allocation) chain-root)
(unless chain
(fprintf stderr "Expected to successfully create chain, but it failed\n")
(return 1))
@ -286,7 +286,7 @@
(fprintf stderr "Failed linear allocation to full link\n")
(chain-allocation-free chain-root)
(return 1))
(var previous-link (* chain-allocation) chain)
(var previous-link (addr chain-allocation) chain)
(unless (and (chain-allocate-unaligned (addr chain) 32) (!= previous-link chain))
(fprintf stderr "Failed re-allocation after full link\n")
(chain-allocation-free chain-root)
@ -302,9 +302,9 @@
;; Make sure we're at a wacky alignment
(chain-allocate-unaligned (addr chain) 3)
(defstruct my-align-struct
thing (* void)
thing (addr void)
c (unsigned char))
(var-cast-to first-aligned (* my-align-struct)
(var-cast-to first-aligned (addr my-align-struct)
(chain-allocate-aligned (addr chain)
(sizeof (type my-align-struct))
(alignof (type my-align-struct))))
@ -315,7 +315,7 @@
(return 1))
;; Ensure we are packed nicely once the first element is aligned
(var-cast-to second-aligned (* my-align-struct)
(var-cast-to second-aligned (addr my-align-struct)
(chain-allocate-aligned (addr chain)
(sizeof (type my-align-struct))
(alignof (type my-align-struct))))
@ -328,7 +328,7 @@
;; Make sure to exercise case where block is too small to fit aligned struct
(each-in-range 100 i
(var-cast-to many-aligned (* my-align-struct)
(var-cast-to many-aligned (addr my-align-struct)
(chain-allocate-aligned (addr chain)
(sizeof (type my-align-struct))
(alignof (type my-align-struct))))
@ -340,7 +340,7 @@
;; Use valgrind to verify this one
(var num-contiguous (const int) 100)
(var contiguous-aligned-array (* my-align-struct)
(var contiguous-aligned-array (addr my-align-struct)
(chain-allocate-aligned-type (addr chain) my-align-struct num-contiguous))
(each-in-range num-contiguous i
(set (field (at i contiguous-aligned-array) c) 'a'))

18
src/Aubio.cake

@ -5,7 +5,7 @@
"mathutils.h"
&with-decls "<stdint.h>")
(defun audio-detect-pitch (buffer (* (const uint8_t)) buffer-size int
(defun audio-detect-pitch (buffer (addr (const uint8_t)) buffer-size int
sample-rate int &return float)
(unless (aubio_is_power_of_two buffer-size)
(var nearest-power-of-two int (/ (aubio_next_power_of_two buffer-size) 2))
@ -13,10 +13,10 @@
(var hop-size uint_t buffer-size) ;; TODO: What is this?
(var pitch-detection (* aubio_pitch_t)
(var pitch-detection (addr aubio_pitch_t)
(new_aubio_pitch "yinfft" buffer-size hop-size sample-rate))
(var buffer-float (* fvec_t) (new_fvec buffer-size))
(var buffer-float (addr fvec_t) (new_fvec buffer-size))
(scope
(var i int 0)
@ -25,7 +25,7 @@
(fvec_set_sample buffer-float converted-sample i)
(incr i)))
(var detected-pitch-buffer (* fvec_t) (new_fvec buffer-size))
(var detected-pitch-buffer (addr fvec_t) (new_fvec buffer-size))
(aubio_pitch_do pitch-detection buffer-float detected-pitch-buffer)
;; (fprintf stderr "Buffer:\n")
@ -54,18 +54,18 @@
(var hop-size uint_t 4096) ;; TODO: What is this?
(var sample-rate uint_t 44100)
(var pitch-detection (* aubio_pitch_t)
(var pitch-detection (addr aubio_pitch_t)
(new_aubio_pitch "yinfft" buffer-size hop-size sample-rate))
(var buffer (* fvec_t) (new_fvec buffer-size))
(var buffer (addr fvec_t) (new_fvec buffer-size))
(var sound-source (* aubio_source_t)
(var sound-source (addr aubio_source_t)
(new_aubio_source "assets/Tone_440.wav" sample-rate hop-size))
(var frames-read uint_t 0)
(aubio_source_do sound-source buffer (addr frames-read))
(fprintf stderr "Read %d frames\n" frames-read)
(var detected-pitch (* fvec_t) (new_fvec buffer-size))
(var detected-pitch (addr fvec_t) (new_fvec buffer-size))
(aubio_pitch_do pitch-detection buffer detected-pitch)
(fprintf stderr "Pitch: %f\n" (fvec_get_sample detected-pitch 0))
@ -84,7 +84,7 @@
(add-cakelisp-search-directory "Dependencies/cakelisp/runtime")
(import "ComptimeHelpers.cake" "BuildTools.cake" "Dependencies.cake")
(defun-comptime build-aubio (manager (& ModuleManager) module (* Module) &return bool)
(defun-comptime build-aubio (manager (ref ModuleManager) module (addr Module) &return bool)
(comptime-cond
('Windows
(comptime-error "Aubio build needs to be ported to Windows."))

12
src/AutoTest.cake

@ -11,9 +11,9 @@
(defun main (&return int) (return 0))
;; Post references resolved hook find-add-tests will create a main function and call test functions
(defun-comptime find-add-tests (environment (& EvaluatorEnvironment) &return bool)
(var functions-to-test (<> std::vector (<> std::pair std::string (* (const Token)))))
(for-in definition-pair (& ObjectDefinitionPair) (field environment definitions)
(defun-comptime find-add-tests (environment (ref EvaluatorEnvironment) &return bool)
(var functions-to-test (template (in std vector) (template (in std pair) (in std string) (addr (const Token)))))
(for-in definition-pair (ref ObjectDefinitionPair) (field environment definitions)
(unless (= 0 (call-on find (field definition-pair first) "test--"))
(continue))
(call-on push_back functions-to-test (call (in std make_pair)
@ -27,12 +27,12 @@
(unless (call-on empty functions-to-test)
;; We're copying this to the main def, so it's fine if it gets destroyed
(var test-body (<> std::vector Token))
(var test-body (template (in std vector) Token))
(var main-definition (* (<> std::vector Token)) (new (<> std::vector Token)))
(var main-definition (addr (template (in std vector) Token)) (new (template (in std vector) Token)))
(call-on push_back (field environment comptimeTokens) main-definition)
(for-in function-pair (& (<> std::pair std::string (* (const Token)))) functions-to-test
(for-in function-pair (ref (template (in std pair) (in std string) (addr (const Token)))) functions-to-test
(var function-name-token Token (deref (field function-pair second)))
(set (field function-name-token type) TokenType_Symbol)
(set (field function-name-token contents) (field function-pair first))

76
src/AutoUpdate.cake

@ -33,23 +33,23 @@
(c-import &with-decls "<stddef.h>")
(def-introspect-struct auto-update-download
operating-system ([] 32 char)
architecture ([] 32 char)
url ([] 1024 char)
operating-system (array 32 char)
architecture (array 32 char)
url (array 1024 char)
;; After the update, this file should be used for the latest version (e.g. executable or DLL)
file-to-use ([] 1024 char))
file-to-use (array 1024 char))
(def-introspect-struct auto-update-metadata
name ([] 64 char)
name (array 64 char)
latest-version int
changelog (* char)
downloads (* auto-update-download) (override 'dynarray))
changelog (addr char)
downloads (addr auto-update-download) (override 'dynarray))
(def-type-alias-global CURL void)
(defun auto-update-get-current-platform-download (update-data (* auto-update-metadata)
&return (* auto-update-download))
(each-item-addr-in-dynarray (path update-data > downloads) i download (* auto-update-download)
(defun auto-update-get-current-platform-download (update-data (addr auto-update-metadata)
&return (addr auto-update-download))
(each-item-addr-in-dynarray (path update-data > downloads) i download (addr auto-update-download)
(comptime-cond
('Windows
(when (and
@ -64,8 +64,8 @@
(return null))
;; TODO: Add version header
(defun auto-update-get-latest-version-metadata (curl (* CURL) update-cakedata-url (* (const char))
update-data-out (* auto-update-metadata)
(defun auto-update-get-latest-version-metadata (curl (addr CURL) update-cakedata-url (addr (const char))
update-data-out (addr auto-update-metadata)
&return bool)
(var result-buffer dynstring null)
(dynarray-set-capacity result-buffer (* 1024 4)) ;; 4 kib
@ -85,23 +85,23 @@
(dynarray-free result-buffer)
(return true))
(defun auto-update-download-and-verify-signature (curl (* CURL)
url (* (const char))
public-key (* (unsigned char))
verified-payload-out (* (* (unsigned char)))
verified-payload-out-size (* (unsigned (long long)))
(defun auto-update-download-and-verify-signature (curl (addr CURL)
url (addr (const char))
public-key (addr (unsigned char))
verified-payload-out (addr (addr (unsigned char)))
verified-payload-out-size (addr (unsigned (long long)))
&return bool)
(set (deref verified-payload-out-size) 0)
(var result-buffer (* char) null)
(var result-buffer (addr char) null)
(unless (curl-download-into-dynarray curl url (addr result-buffer))
(dynarray-free result-buffer)
(return false))
;; This will contain the extra bytes from the signature, which is wasted, but minimal
(set (deref verified-payload-out)
(type-cast (malloc (dynarray-length result-buffer)) (* (unsigned char))))
(type-cast (malloc (dynarray-length result-buffer)) (addr (unsigned char))))
(unless (= 0 (crypto_sign_open (deref verified-payload-out) verified-payload-out-size
(type-cast result-buffer (* (const (unsigned char))))
(type-cast result-buffer (addr (const (unsigned char))))
(dynarray-length result-buffer)
public-key))
(fprintf stderr "warning: the downloaded file's signature does NOT appear to be signed
@ -122,14 +122,14 @@
;; new-file-to-use-out-buffer will only be set if there was actually a newer file
;; changelog-out may be null if not provided
;; Note: Any more args and this should take an args struct, or return the metadata!
(defun auto-update-download (curl (* CURL) public-key (* (unsigned char))
update-cakedata-url (* (const char))
(defun auto-update-download (curl (addr CURL) public-key (addr (unsigned char))
update-cakedata-url (addr (const char))
current-application-version int
output-directory (* (const char))
new-file-to-use-out-buffer (* char)
output-directory (addr (const char))
new-file-to-use-out-buffer (addr char)
new-file-to-use-out-buffer-size size_t
new-version-out (* int)
changelog-out (* (* char))
new-version-out (addr int)
changelog-out (addr (addr char))
&return bool)
(var update-metadata auto-update-metadata (array 0))
(unless (auto-update-get-latest-version-metadata
@ -140,18 +140,18 @@
(free-introspect-struct-fields auto-update-metadata--metadata (addr update-metadata) free)
(return false))
(var platform-download (* auto-update-download)
(var platform-download (addr auto-update-download)
(auto-update-get-current-platform-download (addr update-metadata)))
(unless platform-download
(fprintf stderr "Could not find update for this platform\n")
(free-introspect-struct-fields auto-update-metadata--metadata (addr update-metadata) free)
(return false))
(var platform-update-url (* (const char)) (path platform-download > url))
(var platform-update-url (addr (const char)) (path platform-download > url))
(scope ;; Print results
(fprintf stderr "Latest version of %s is %d.\nDownloads:\n"
(field update-metadata name) (field update-metadata latest-version))
(each-item-addr-in-dynarray (field update-metadata downloads) i download (* auto-update-download)
(each-item-addr-in-dynarray (field update-metadata downloads) i download (addr auto-update-download)
(fprintf stderr "\t%s %s at %s\n" (path download > operating-system)
(path download > architecture)
(path download > url)))
@ -164,7 +164,7 @@
(free-introspect-struct-fields auto-update-metadata--metadata (addr update-metadata) free)
(return true))
(var verified-payload (* (unsigned char)) null)
(var verified-payload (addr (unsigned char)) null)
(var verified-payload-size (unsigned (long long)) 0)
(unless (auto-update-download-and-verify-signature curl platform-update-url public-key
(addr verified-payload)
@ -172,7 +172,7 @@
(free-introspect-struct-fields auto-update-metadata--metadata (addr update-metadata) free)
(return false))
(var version-output-directory ([] 1024 char) (array 0))
(var version-output-directory (array 1024 char) (array 0))
(sprintf version-output-directory "%s/v%d" output-directory (field update-metadata latest-version))
(unless (and (make-directory output-directory)
(make-directory version-output-directory))
@ -198,7 +198,7 @@
(return true))
;; Retain the ability to use another allocator within this module
(defun auto-update-changelog-free (changelog (* char))
(defun auto-update-changelog-free (changelog (addr char))
(when changelog
(free changelog)))
@ -212,20 +212,20 @@
;; Creating an auto-update file:
;; zip test.zip TestSerialize.cakedata TestDictionarySerialize.cakedata
;; ./cryptography-cli create-signed-file test.zip ~/website/updates/Product/Product_Linux-x64.auto-update
(var macoy-public-key ([] crypto_sign_PUBLICKEYBYTES (unsigned char))
(var macoy-public-key (array crypto_sign_PUBLICKEYBYTES (unsigned char))
(array 0x8a 0xd0 0x2a 0x05 0x0a 0x57 0xe8 0x4c 0x7c 0x73 0xcf 0xdb 0x26 0xdd 0xb9 0xf7 0x6f 0x92
0x05 0xe6 0x5f 0xa5 0xf7 0xf4 0x50 0x87 0x33 0xec 0x5f 0xb0 0x66 0x84))
(var update-cakedata-url (* (const char))
(var update-cakedata-url (addr (const char))
"https://localhost:8888/updates/Machsearch/machsearch.cakedata")
(var current-version int 0)
(var output-directory (* (const char)) ".")
(var new-file-to-use ([] 2048 char) (array 0))
(var output-directory (addr (const char)) ".")
(var new-file-to-use (array 2048 char) (array 0))
(when (!= (curl_global_init CURL_GLOBAL_DEFAULT) 0)
(fprintf stderr "error: Failed to initialize curl\n")
(return 1))
(var curl (* CURL) (curl_easy_init))
(var curl (addr CURL) (curl_easy_init))
(unless curl
(fprintf stderr "error: Failed to get curl\n")
(curl_global_cleanup)
@ -236,7 +236,7 @@
(curl_easy_setopt curl CURLOPT_SSL_VERIFYHOST 0)
(var new-version int 0)
(var changelog (* char) null)
(var changelog (addr char) null)
(unless (auto-update-download curl macoy-public-key update-cakedata-url current-version
output-directory new-file-to-use (sizeof new-file-to-use)
(addr new-version) (addr changelog))

34
src/AutoUpdateApplication.cake

@ -17,24 +17,24 @@
;; Stored separately from app data so that at startup the old version isn't confused by new version userdata
(def-introspect-struct auto-update-data
auto-update-executable ([] 2048 char)
auto-update-executable (array 2048 char)
auto-update-version int)
(var s-auto-update-version-header version-header (array 2))
(var s-auto-update-data auto-update-data (array 0))
(var s-new-file-to-use ([] 2048 char) (array 0)) ;; TODO hacky
(var s-new-file-to-use (array 2048 char) (array 0)) ;; TODO hacky
;; TODO Make not global
(var-global g-is-self-updating bool false)
(var-global g-new-version int 0)
(var-global g-new-version-changelog (* char) null)
(var-global g-new-version-changelog (addr char) null)
(var s-last-time-checked-for-update float 0.f)
(var s-self-update-throttle-interval-seconds (const float) 15.f)
(var-global g-self-update-load-error-string ([] 2048 char) (array 0))
(var-global g-self-update-save-error-string ([] 2048 char) (array 0))
(var-global g-self-update-load-error-string (array 2048 char) (array 0))
(var-global g-self-update-save-error-string (array 2048 char) (array 0))
(defenum self-update-status
self-update-status-none
@ -45,7 +45,7 @@
(var-global g-self-update-status self-update-status self-update-status-none)
(var s-curl (* CURL) null)
(var s-curl (addr CURL) null)
;; zip machsearch.zip machsearch
;; In gamelib/test:
@ -53,13 +53,13 @@
(defstruct self-update-parameters
current-version int
output-directory (* (const char))
curl (* void) ;; May be null if self-update should handle CURL acquisition
output-directory (addr (const char))
curl (addr void) ;; May be null if self-update should handle CURL acquisition
;; Should be crypto_sign_PUBLICKEYBYTES in length
public-key (* (unsigned char))
update-cakedata-url (* (const char)))
public-key (addr (unsigned char))
update-cakedata-url (addr (const char)))
(def-task try-to-auto-update (arguments (* self-update-parameters) result-out (* self-update-status))
(def-task try-to-auto-update (arguments (addr self-update-parameters) result-out (addr self-update-status))
(when g-new-version-changelog
(auto-update-changelog-free g-new-version-changelog)
(set g-new-version-changelog null))
@ -87,7 +87,7 @@
(set g-is-self-updating false))
;; NOTE: These arguments need to persist until g-is-self-updating = false
(defun self-update (arguments (* self-update-parameters))
(defun self-update (arguments (addr self-update-parameters))
(when (self-update-is-throttling)
(fprintf stderr "Self-update request ignored (throttling)\n")
(return))
@ -124,7 +124,7 @@
(auto-update-finished :pin-to-main-thread))
(set g-is-self-updating true))
(defun-local self-update-save-config (filename (* (const char)))
(defun-local self-update-save-config (filename (addr (const char)))
(var read-version version-header (array 0))
(var result versioned-data-result
(save-versioned-data filename
@ -135,7 +135,7 @@
(sizeof g-self-update-save-error-string))))
;; User says they want to run the new version
(defun self-update-confirm (filename (* (const char)))
(defun self-update-confirm (filename (addr (const char)))
(strcpy (field s-auto-update-data auto-update-executable) s-new-file-to-use)
(set (field s-auto-update-data auto-update-version) g-new-version)
(set g-self-update-status self-update-status-request-restart-to-new-version)
@ -164,11 +164,11 @@
(var arguments RunProcessArguments (array 0))
(set (field arguments fileToExecute) s-new-file-to-use)
(set (field arguments workingDirectory) null) ;; working dir same as parent
(var final-command (* (* char)) null) ;; dynarray
(var final-command (addr (addr char)) null) ;; dynarray
(dynarray-set-length final-command 2)
(set (at 0 final-command) s-new-file-to-use)
(set (at 1 final-command) null)
(set (field arguments arguments) (type-cast final-command (* (* (const char)))))
(set (field arguments arguments) (type-cast final-command (addr (addr (const char)))))
(var-static status int 0)
(unless (= 0 (runProcess arguments (addr status)))
;; TODO Output to user
@ -209,7 +209,7 @@
(free-introspect-struct-fields auto-update-data--metadata
(addr s-auto-update-data) free))
(defun self-update-load-config (filename (* (const char)))
(defun self-update-load-config (filename (addr (const char)))
(var read-version version-header (array 0))
(var load-result versioned-data-result
(load-versioned-data filename

14
src/Compression.cake

@ -12,9 +12,9 @@
(c-import "miniz.h" &with-decls "<stddef.h>")
;; TODO Limitation: subdirectories will not be created
(defun decompress-zip-from-memory-to-files (buffer (* (const void))
(defun decompress-zip-from-memory-to-files (buffer (addr (const void))
size size_t
output-directory (* (const char))
output-directory (addr (const char))
&return bool)
(var archive mz_zip_archive)
(mz_zip_zero_struct (addr archive))
@ -26,8 +26,8 @@
(var num-files (unsigned int) (mz_zip_reader_get_num_files (addr archive)))
(fprintf stderr "Archive has %d files\n" num-files)
(var filename-buffer ([] 1024 char) (array 0))
(var output-filename-buffer ([] 2048 char) (array 0))
(var filename-buffer (array 1024 char) (array 0))
(var output-filename-buffer (array 2048 char) (array 0))
(each-in-range num-files i
(mz_zip_reader_get_filename (addr archive) i filename-buffer (sizeof filename-buffer))
(sprintf output-filename-buffer "%s/%s" output-directory filename-buffer)
@ -45,7 +45,7 @@
(c-import "<stdio.h>")
(defun test--compression (&return int)
(fprintf stderr "miniz version %s\n" (mz_version))
(var zip-filename (* (const char)) "test.zip")
(var zip-filename (addr (const char)) "test.zip")
(var archive mz_zip_archive)
(mz_zip_zero_struct (addr archive))
@ -56,8 +56,8 @@
(var num-files (unsigned int) (mz_zip_reader_get_num_files (addr archive)))
(fprintf stderr "Archive has %d files\n" num-files)
(var filename-buffer ([] 1024 char) (array 0))
(var output-filename-buffer ([] 2048 char) (array 0))
(var filename-buffer (array 1024 char) (array 0))
(var output-filename-buffer (array 2048 char) (array 0))
(each-in-range num-files i
(mz_zip_reader_get_filename (addr archive) i filename-buffer (sizeof filename-buffer))
(sprintf output-filename-buffer "%s" filename-buffer)

12
src/Config_ZigCompile.cake

@ -4,13 +4,13 @@
;; Use Zig's bundled toolchain to compile our Cakelisp app
;; Note that it's too late to use this for compile-time. You'd need to already have zig extracted
(defun-comptime download-set-zig (manager (& ModuleManager) module (* Module) &return bool)
(var zig-name ([] 1024 char) "zig-linux-x86_64-0.9.0-dev.1733+8f1e41775")
(var archive-url ([] 1024 char) (array 0))
(defun-comptime download-set-zig (manager (ref ModuleManager) module (addr Module) &return bool)
(var zig-name (array 1024 char) "zig-linux-x86_64-0.9.0-dev.1733+8f1e41775")
(var archive-url (array 1024 char) (array 0))
(PrintfBuffer archive-url "https://ziglang.org/builds/%s.tar.xz" zig-name)
(var zig-archive ([] 1024 char) (array 0))
(var zig-archive (array 1024 char) (array 0))
(PrintfBuffer zig-archive "cakelisp_cache/%s.tar.xz" zig-name)
(var extracted-zig-executable ([] 1024 char) (array 0))
(var extracted-zig-executable (array 1024 char) (array 0))
(PrintfBuffer extracted-zig-executable "cakelisp_cache/%s/zig" zig-name)
(unless (fileExists extracted-zig-executable)
@ -22,7 +22,7 @@
(return false)))
(unless (fileExists extracted-zig-executable)
(var input-archive-arg ([] 1024 char) (array 0))
(var input-archive-arg (array 1024 char) (array 0))
(PrintfBuffer input-archive-arg "--file=%s" zig-archive)
(Logf "Extracting Zig from %s\n" zig-archive)
(run-process-sequential-or

68
src/Cryptography.cake

@ -22,8 +22,8 @@
;; TODO: Clean this up...
(defun print-signature-keys (public-key (* (unsigned char))
secret-key (* (unsigned char)))
(defun print-signature-keys (public-key (addr (unsigned char))
secret-key (addr (unsigned char)))
(fprintf stderr "Public key:\n")
(each-in-range crypto_sign_PUBLICKEYBYTES i
(fprintf stderr "%02x " (at i public-key)))
@ -32,14 +32,14 @@
;; (fprintf stderr "%02x " (at i secret-key)))
(fprintf stderr "\n"))
(defun generate-signature-keys-to-file (filename (* (const char)) &return int)
(defun generate-signature-keys-to-file (filename (addr (const char)) &return int)
(fprintf stderr "Generating public and secret keys\n")
(var public-key ([] crypto_sign_PUBLICKEYBYTES (unsigned char)))
(var secret-key ([] crypto_sign_SECRETKEYBYTES (unsigned char)))
(var public-key (array crypto_sign_PUBLICKEYBYTES (unsigned char)))
(var secret-key (array crypto_sign_SECRETKEYBYTES (unsigned char)))
(crypto_sign_keypair public-key secret-key)
(print-signature-keys public-key secret-key)
(var out-file (* FILE) (fopen filename "wb"))
(var out-file (addr FILE) (fopen filename "wb"))
(unless out-file
(fprintf stderr "Failed to open key file '%s'.\n" filename)
(return 1))
@ -49,11 +49,11 @@
(fprintf stderr "Keys saved to %s\n" filename)
(return 0))
(defun load-signature-keys-from-file (filename (* (const char))
public-key-out (* (unsigned char))
secret-key-out (* (unsigned char))
(defun load-signature-keys-from-file (filename (addr (const char))
public-key-out (addr (unsigned char))
secret-key-out (addr (unsigned char))
&return bool)
(var in-file (* FILE) (fopen filename "rb"))
(var in-file (addr FILE) (fopen filename "rb"))
(unless in-file
(fprintf stderr "Failed to open key file '%s'. You can generate new keys with the generate-keys command.\n"
filename)
@ -67,8 +67,8 @@
;; "box" keys (public key encryption)
;;
(defun-local print-box-keys (public-key (* (unsigned char))
secret-key (* (unsigned char)))
(defun-local print-box-keys (public-key (addr (unsigned char))
secret-key (addr (unsigned char)))
(fprintf stderr "Public key:\n")
(each-in-range crypto_box_PUBLICKEYBYTES i
(fprintf stderr "0x%02x " (at i public-key)))
@ -77,14 +77,14 @@
;; (fprintf stderr "0x%02x " (at i secret-key)))
(fprintf stderr "\n"))
(defun generate-box-keys-to-file (filename (* (const char)) &return int)
(defun generate-box-keys-to-file (filename (addr (const char)) &return int)
(fprintf stderr "Generating public and secret keys\n")
(var public-key ([] crypto_box_PUBLICKEYBYTES (unsigned char)))
(var secret-key ([] crypto_box_SECRETKEYBYTES (unsigned char)))
(var public-key (array crypto_box_PUBLICKEYBYTES (unsigned char)))
(var secret-key (array crypto_box_SECRETKEYBYTES (unsigned char)))
(crypto_box_keypair public-key secret-key)
(print-box-keys public-key secret-key)
(var out-file (* FILE) (fopen filename "wb"))
(var out-file (addr FILE) (fopen filename "wb"))
(unless out-file
(fprintf stderr "Failed to open key file '%s'.\n" filename)
(return 1))
@ -94,11 +94,11 @@
(fprintf stderr "Keys saved to %s\n" filename)
(return 0))
(defun load-box-keys-from-file (filename (* (const char))
public-key-out (* (unsigned char))
secret-key-out (* (unsigned char))
(defun load-box-keys-from-file (filename (addr (const char))
public-key-out (addr (unsigned char))
secret-key-out (addr (unsigned char))
&return bool)
(var in-file (* FILE) (fopen filename "rb"))
(var in-file (addr FILE) (fopen filename "rb"))
(unless in-file
(fprintf stderr "Failed to open key file '%s'. You can generate new keys with the generate-keys command.\n"
filename)
@ -117,24 +117,24 @@
(return 1))
(scope ;; Public key signature
(var public-key ([] crypto_sign_PUBLICKEYBYTES (unsigned char)))
(var secret-key ([] crypto_sign_SECRETKEYBYTES (unsigned char)))
(var public-key (array crypto_sign_PUBLICKEYBYTES (unsigned char)))
(var secret-key (array crypto_sign_SECRETKEYBYTES (unsigned char)))
(crypto_sign_keypair public-key secret-key)
(var-cast-to message (* (const (unsigned char))) "My message") ;; 10 characters
(var signed-message ([] (+ crypto_sign_BYTES 10) (unsigned char)))
(var-cast-to message (addr (const (unsigned char))) "My message") ;; 10 characters
(var signed-message (array (+ crypto_sign_BYTES 10) (unsigned char)))
(var signed-message-length (unsigned (long long)))
(crypto_sign signed-message (addr signed-message-length)
message 10 secret-key)
(var unsigned-message ([] 10 (unsigned char)))
(var unsigned-message (array 10 (unsigned char)))
(var unsigned-message-length (unsigned (long long)))
(unless (= 0 (crypto_sign_open unsigned-message (addr unsigned-message-length)
signed-message signed-message-length public-key))
(fprintf stderr "error: Failed to verify signature\n")
(return 1))
(var bad-public-key ([] crypto_sign_PUBLICKEYBYTES (unsigned char)))
(var bad-secret-key ([] crypto_sign_SECRETKEYBYTES (unsigned char)))
(var bad-public-key (array crypto_sign_PUBLICKEYBYTES (unsigned char)))
(var bad-secret-key (array crypto_sign_SECRETKEYBYTES (unsigned char)))
(crypto_sign_keypair bad-public-key bad-secret-key)
(crypto_sign signed-message (addr signed-message-length)
message 10 bad-secret-key)
@ -148,8 +148,8 @@
;; Building
;;
(defun-comptime build-libsodium (manager (& ModuleManager) module (* Module) &return bool)
(var libsodium-archive (* (const char))
(defun-comptime build-libsodium (manager (ref ModuleManager) module (addr Module) &return bool)
(var libsodium-archive (addr (const char))
(comptime-cond ('Windows "Dependencies/libsodium/bin/x64/Release/v141/static/libsodium.lib")
('Unix "cakelisp_cache/LibSodiumInstallDir/lib/libsodium.a")))
;; Already built?
@ -161,15 +161,15 @@
('Unix
(Log "LibSodium: Building via Configure and Make\n")
(var working-dir (* (const char)) "cakelisp_cache/LibSodiumBuildDir")
(var working-dir (addr (const char)) "cakelisp_cache/LibSodiumBuildDir")
(makeDirectory working-dir)
(var output-dir (* (const char)) "cakelisp_cache/LibSodiumInstallDir")
(var output-dir (addr (const char)) "cakelisp_cache/LibSodiumInstallDir")
(makeDirectory output-dir)
(var configure-output-prefix ([] MAX_PATH_LENGTH char) (array 0))
(var configure-output-prefix (array MAX_PATH_LENGTH char) (array 0))
(scope ;; Output must be absolute directory
(var absolute-output-path (* (const char))
(var absolute-output-path (addr (const char))
(makeAbsolutePath_Allocated null output-dir))
(unless absolute-output-path
@ -177,7 +177,7 @@
(return false))
(PrintfBuffer configure-output-prefix "--prefix=%s" absolute-output-path)
(free (type-cast absolute-output-path (* void))))
(free (type-cast absolute-output-path (addr void))))
(run-process-sequential-or
("autoreconf" "-vfi" :in-directory "Dependencies/libsodium")

66
src/CryptographyCLI.cake

@ -4,7 +4,7 @@
(c-import "<string.h>")
(var s-keys-filename (* (const char)) "PublicAndSecretKeys.bin")
(var s-keys-filename (addr (const char)) "PublicAndSecretKeys.bin")
;;
;; Command registration
@ -12,7 +12,7 @@
(defmacro defcommand (command-name symbol arguments array &rest body any)
(get-or-create-comptime-var command-table (<> (in std vector) (* (const Token))))
(get-or-create-comptime-var command-table (template (in std vector) (addr (const Token))))
(call-on-ptr push_back command-table command-name)
(tokenize-push output
@ -20,18 +20,18 @@
(token-splice-rest body tokens)))
(return true))
(defun-comptime create-command-lookup-table (environment (& EvaluatorEnvironment) &return bool)
(defun-comptime create-command-lookup-table (environment (ref EvaluatorEnvironment) &return bool)
(get-or-create-comptime-var command-table-already-created bool false)
(when (deref command-table-already-created)
(return true))
(set (deref command-table-already-created) true)
(get-or-create-comptime-var command-table (<> (in std vector) (* (const Token))))
(get-or-create-comptime-var command-table (template (in std vector) (addr (const Token))))
(var command-data (* (<> std::vector Token)) (new (<> std::vector Token)))
(var command-data (addr (template std::vector Token)) (new (template std::vector Token)))
(call-on push_back (field environment comptimeTokens) command-data)
(for-in command-name (* (const Token)) (deref command-table)
(for-in command-name (addr (const Token)) (deref command-table)
(var command-name-string Token (deref command-name))
(set (field command-name-string type) TokenType_String)
@ -39,10 +39,10 @@
(array (token-splice-addr command-name-string)
(token-splice command-name))))
(var command-table-tokens (* (<> std::vector Token)) (new (<> std::vector Token)))
(var command-table-tokens (addr (template std::vector Token)) (new (template std::vector Token)))
(call-on push_back (field environment comptimeTokens) command-table-tokens)
(tokenize-push (deref command-table-tokens)
(var command-table ([] command-metadata)
(var command-table (array command-metadata)
(array (token-splice-array (deref command-data)))))
(return (ClearAndEvaluateAtSplicePoint environment "command-lookup-table" command-table-tokens)))
@ -50,10 +50,10 @@
(add-compile-time-hook post-references-resolved
create-command-lookup-table)
(def-function-signature command-function (num-arguments int arguments ([] (* (const char))) &return int))
(def-function-signature command-function (num-arguments int arguments (array (addr (const char))) &return int))
(defstruct-local command-metadata
name (* (const char))
name (addr (const char))
command command-function)
(splice-point command-lookup-table)
@ -62,45 +62,45 @@
;; Commands
;;
(defcommand generate-keys (num-arguments int arguments ([] (* (const char))) &return int)
(defcommand generate-keys (num-arguments int arguments (array (addr (const char))) &return int)
(fprintf stderr "Generating public and secret keys\n")
(return (generate-signature-keys-to-file s-keys-filename)))
(defcommand list-keys (num-arguments int arguments ([] (* (const char))) &return int)
(var public-key ([] crypto_sign_PUBLICKEYBYTES (unsigned char)))
(var secret-key ([] crypto_sign_SECRETKEYBYTES (unsigned char)))
(defcommand list-keys (num-arguments int arguments (array (addr (const char))) &return int)
(var public-key (array crypto_sign_PUBLICKEYBYTES (unsigned char)))
(var secret-key (array crypto_sign_SECRETKEYBYTES (unsigned char)))
(unless (load-signature-keys-from-file s-keys-filename public-key secret-key)
(return 1))
(print-signature-keys public-key secret-key)
(return 0))
(defun-local create-signed-file-internal (keys-filename (* (const char))
input-filename (* (const char))
output-filename (* (const char))
(defun-local create-signed-file-internal (keys-filename (addr (const char))
input-filename (addr (const char))
output-filename (addr (const char))
&return int)
(var public-key ([] crypto_sign_PUBLICKEYBYTES (unsigned char)))
(var secret-key ([] crypto_sign_SECRETKEYBYTES (unsigned char)))
(var public-key (array crypto_sign_PUBLICKEYBYTES (unsigned char)))
(var secret-key (array crypto_sign_SECRETKEYBYTES (unsigned char)))
(unless (load-signature-keys-from-file keys-filename public-key secret-key)
(fprintf stderr "Generate keys with generate-keys first before trying to create a signed file.\n")
(return 1))
(fprintf stderr "Signing file %s with the following keys:\n" input-filename)
(print-signature-keys public-key secret-key)
(var input-file (* FILE) (fopen input-filename "rb"))
(var input-file (addr FILE) (fopen input-filename "rb"))
(unless input-file
(fprintf stderr "error: Failed to open input file %s.\n" input-filename)
(return 1))
(var input-file-size size_t)
(var-cast-to file-contents (* (unsigned char))
(var-cast-to file-contents (addr (unsigned char))
(read-file-into-memory-ex input-file 0 (addr input-file-size)))
(fclose input-file)
(var-cast-to signed-contents (* (unsigned char)) (malloc (+ input-file-size crypto_sign_BYTES)))
(var-cast-to signed-contents (addr (unsigned char)) (malloc (+ input-file-size crypto_sign_BYTES)))
(var signed-contents-length (unsigned (long long)))
(crypto_sign signed-contents (addr signed-contents-length)
file-contents input-file-size secret-key)
(var output-file (* FILE) (fopen output-filename "wb"))
(var output-file (addr FILE) (fopen output-filename "wb"))
(unless output-file
(fprintf stderr "error: Failed to open output file %s.\n" output-filename)
(free signed-contents)
@ -116,14 +116,14 @@
(free file-contents)
(return 0))
(defcommand create-signed-file (num-arguments int arguments ([] (* (const char))) &return int)
(defcommand create-signed-file (num-arguments int arguments (array (addr (const char))) &return int)
(unless (= 2 num-arguments)
(fprintf stderr "Command create-signed-file expects two arguments: [input file] [output file]\n")
(return 1))
(return (create-signed-file-internal s-keys-filename (at 0 arguments) (at 1 arguments))))
(defcommand create-signed-file-with-keys (num-arguments int arguments ([] (* (const char))) &return int)
(defcommand create-signed-file-with-keys (num-arguments int arguments (array (addr (const char))) &return int)
(unless (= 3 num-arguments)
(fprintf stderr "Command create-signed-file-with-keys expects three arguments:
[keys file] [input file] [output file]\n")
@ -131,32 +131,32 @@
(return (create-signed-file-internal
(at 0 arguments) (at 1 arguments) (at 2 arguments))))
(defcommand verify-signed-file (num-arguments int arguments ([] (* (const char))) &return int)
(defcommand verify-signed-file (num-arguments int arguments (array (addr (const char))) &return int)
(unless (= 1 num-arguments)
(fprintf stderr "Command create-signed-file expects one argument: [input file]\n")
(return 1))
(var input-filename (* (const char)) (at 0 arguments))
(var input-filename (addr (const char)) (at 0 arguments))
(var public-key ([] crypto_sign_PUBLICKEYBYTES (unsigned char)))
(var secret-key ([] crypto_sign_SECRETKEYBYTES (unsigned char)))
(var public-key (array crypto_sign_PUBLICKEYBYTES (unsigned char)))
(var secret-key (array crypto_sign_SECRETKEYBYTES (unsigned char)))
(unless (load-signature-keys-from-file s-keys-filename public-key secret-key)
(fprintf stderr "There were no keys found to check against.\n")
(return 1))
(fprintf stderr "Checking signed file %s against the following keys:\n" input-filename)
(print-signature-keys public-key secret-key)
(var input-file (* FILE) (fopen input-filename "rb"))
(var input-file (addr FILE) (fopen input-filename "rb"))
(unless input-file
(fprintf stderr "error: Failed to open input file %s.\n" input-filename)
(return 1))
(var input-file-size size_t)
(var-cast-to file-contents (* (unsigned char))
(var-cast-to file-contents (addr (unsigned char))
(read-file-into-memory-ex input-file 0 (addr input-file-size)))
(fclose input-file)
;; This is a little too big but we don't care about those extra few signature bytes
(var-cast-to unsigned-message (* (unsigned char)) (malloc input-file-size))
(var-cast-to unsigned-message (addr (unsigned char)) (malloc input-file-size))
(var unsigned-message-length (unsigned (long long)))
(unless (= 0 (crypto_sign_open unsigned-message (addr unsigned-message-length)
file-contents input-file-size public-key))
@ -185,7 +185,7 @@ Available commands:
(fprintf stderr " %s\n"
(field (at i command-table) name))))
(defun main (num-arguments int arguments ([] (* (const char))) &return int)
(defun main (num-arguments int arguments (array (addr (const char))) &return int)
(unless (> num-arguments 1)
(fprintf stderr "Expected command.\n")
(print-help)

34
src/Curl.cake

@ -33,7 +33,7 @@
;;
;; TODO Use https://curl.se/libcurl/c/CURLOPT_ERRORBUFFER.html instead
(defun curl-code-to-string (code-untyped (unsigned int) &return (* (const char)))
(defun curl-code-to-string (code-untyped (unsigned int) &return (addr (const char)))
(var code CURLcode (type-cast code-untyped CURLcode))
;; TODO Convert to switch
(cond
@ -239,18 +239,18 @@
(return "CURL_LAST")))
(return "none"))
(defun-local curl-receive-data-into-dynarray (buffer (* void) size size_t num-members size_t userdata (* void)
(defun-local curl-receive-data-into-dynarray (buffer (addr void) size size_t num-members size_t userdata (addr void)
&return size_t)
(var total-size size_t (* size num-members))
(var-cast-to result-out (* dynstring) userdata)
(var-cast-to result-out (addr dynstring) userdata)
(var size-before-append size_t (dynarray-length (deref result-out)))
(dynarray-set-length (deref result-out) (+ size-before-append total-size))
(memcpy (+ (deref result-out) size-before-append) buffer total-size)
(return total-size))
;; Note: Will NOT null-terminate because the data doesn't have to be a string.
(defun curl-download-into-dynarray (curl (* CURL) url (* (const char))
dynarray-out (* (* char))
(defun curl-download-into-dynarray (curl (addr CURL) url (addr (const char))
dynarray-out (addr (addr char))
&return bool)
(dynarray-clear (deref dynarray-out))
(curl_easy_setopt curl CURLOPT_URL url)
@ -277,22 +277,22 @@
;;
;; TODO Move into BuildTools.cake
(defun-comptime format-absolute-path-into-buffer (buffer (* char) buffer-size size_t
prefix (* (const char))
relative-path (* (const char)) &return bool)
(var absolute-output-path (* (const char))
(defun-comptime format-absolute-path-into-buffer (buffer (addr char) buffer-size size_t
prefix (addr (const char))
relative-path (addr (const char)) &return bool)
(var absolute-output-path (addr (const char))
(makeAbsolutePath_Allocated null relative-path))
(unless absolute-output-path
(return false))
;; Allow passing in null for prefix
(var format-prefix (* (const char)) (? prefix prefix ""))
(var format-prefix (addr (const char)) (? prefix prefix ""))
(SafeSnprintf buffer buffer-size "%s%s" format-prefix absolute-output-path)
(free (type-cast absolute-output-path (* void)))
(free (type-cast absolute-output-path (addr void)))
(return true))
(defun-comptime build-curl (manager (& ModuleManager) module (* Module) &return bool)
(defun-comptime build-curl (manager (ref ModuleManager) module (addr Module) &return bool)
(comptime-cond
('Windows
(when (fileExists "Dependencies/curl/builds/libcurl-vc-x64-release-static-ipv6-sspi-schannel/lib/libcurl_a.lib")
@ -323,9 +323,9 @@
(Log "Curl: Building via Autotools and Make\n")
(var curl-build-dir (* (const char)) "cakelisp_cache/CurlBuild")
(var curl-build-dir (addr (const char)) "cakelisp_cache/CurlBuild")
(makeDirectory curl-build-dir)
(var curl-install-dir (* (const char)) "cakelisp_cache/CurlInstall")
(var curl-install-dir (addr (const char)) "cakelisp_cache/CurlInstall")
(makeDirectory curl-install-dir)
(run-process-sequential-or
@ -349,12 +349,12 @@
(Log "failed at Curl automake step. This requires automake to execute.\n")
(return false))
(var with-openssl ([] 1024 char) (array 0))
(var with-openssl (array 1024 char) (array 0))
(unless (format-absolute-path-into-buffer with-openssl (sizeof with-openssl)
"--with-openssl=" "cakelisp_cache/OpenSSLInstall")
(Log "error: OpenSSL.cake must be imported before Curl so that it is built before curl builds")
(return false))
(var install-prefix ([] 1024 char) (array 0))
(var install-prefix (array 1024 char) (array 0))
(unless (format-absolute-path-into-buffer install-prefix (sizeof install-prefix)
"--prefix=" curl-install-dir)
(return false))
@ -427,7 +427,7 @@
(fprintf stderr "error: Failed to initialize curl\n")
(return 1))
(var curl (* CURL) (curl_easy_init))
(var curl (addr CURL) (curl_easy_init))
(unless curl
(fprintf stderr "error: Failed to get curl\n")
(curl_global_cleanup)

88
src/DataBundle.cake

@ -7,21 +7,21 @@
(defmacro bundle-file (start-var-name symbol end-var-name symbol var-base-type array
filename-token string)
(when (and (= TokenType_Symbol (field (at 1 var-base-type) type))
(std-str-equals (field (at 1 var-base-type) contents) "*"))
(std-str-equals (field (at 1 var-base-type) contents) "addr"))
(ErrorAtToken (at 1 var-base-type)
"bundled file variable type must not be a pointer. It will be automatically pointerized")
(return false))
(var filename (* (const char)) (call-on c_str (path filename-token > contents)))
(get-or-create-comptime-var files-to-bundle (<> (in std vector) (in std string)))
(var filename (addr (const char)) (call-on c_str (path filename-token > contents)))
(get-or-create-comptime-var files-to-bundle (template (in std vector) (in std string)))
(when (= (call-on-ptr end files-to-bundle)
(FindInContainer (deref files-to-bundle) filename))
(call-on-ptr push_back files-to-bundle filename))
(comptime-cond
('Unix
(var data-var-name ([] 1024 char) (array 0))
(var data-var-name-write (* char) data-var-name)
(var data-var-name (array 1024 char) (array 0))
(var data-var-name-write (addr char) data-var-name)
(strncpy data-var-name "_binary_" (array-size data-var-name))
(set data-var-name-write
(+ data-var-name-write (strlen data-var-name)))
@ -43,27 +43,27 @@
(token-splice var-base-type)))
(declare-external (var (token-splice-addr data-var-name-end-token)
(token-splice var-base-type)))
(var (token-splice start-var-name) (* (token-splice var-base-type))
(var (token-splice start-var-name) (addr (token-splice var-base-type))
(addr (token-splice-addr data-var-name-start-token)))
(var (token-splice end-var-name) (* (token-splice var-base-type))