~williewillus/public-inbox

Add byte and call limits to download, and implement framework for more sandbox-wide global limits v1 PROPOSED

: 1
 Add byte and call limits to download, and implement framework for more sandbox-wide global limits

 2 files changed, 71 insertions(+), 21 deletions(-)
Export patchset (mbox)
How do I use this?

Copy & paste the following snippet into your terminal to import this patchset into git:

curl -s https://lists.sr.ht/~williewillus/public-inbox/patches/24018/mbox | git am -3
Learn more about email & git
View this thread in the archives

[PATCH] Add byte and call limits to download, and implement framework for more sandbox-wide global limits Export this patch

From: gamma-delta <29877714+gamma-delta@users.noreply.github.com>

---
 main.rkt              | 80 +++++++++++++++++++++++++++++++------------
 scribblings/r16.scrbl | 12 +++++++
 2 files changed, 71 insertions(+), 21 deletions(-)

diff --git a/main.rkt b/main.rkt
index 112048c..566cbfe 100755
--- a/main.rkt
+++ b/main.rkt
@@ -50,6 +50,15 @@
              (bitwise-and perms)
              ((negate zero?)))))))

; Information globally tracked across an entire sandbox invocation
; for sandbox-wide limits and the like
(struct sandbox-globals (
  download-bytes-allowance
  download-times-allowance
) #:mutable)
(define (default-sandbox-globals)
  (sandbox-globals 64000 5))

(define (strip-backticks code)
  (let ([groups (regexp-match #px"```(\\w+\n)?(.+)```|`(.+)`" code)])
    (if groups
@@ -123,7 +132,7 @@
    (with-typing-indicator client message
      (thunk
       (format-run-result
        (ev:run code (evaluation-ctx #f client message db (context-id message) "" #f) http:attachment?))))))
        (ev:run code (evaluation-ctx #f client message db (context-id message) "" #f (default-sandbox-globals)) http:attachment?))))))

(define (register-trick client db message text)
  (check-trick-prereqs
@@ -157,7 +166,8 @@
                 db
                 context-id
                 (or body "")
                 #f)
                 #f
                 (default-sandbox-globals))
                http:attachment?)))))
         (~a "Trick " name " doesn't exist!")))))

@@ -274,8 +284,8 @@
(define/contract (make-attachment data name type)
  (-> bytes? (or/c string? bytes?) (or/c symbol? string? bytes?) http:attachment?)
  (http:attachment data (~a type) name))
(define/contract ((call-subtrick client db context-id message parent-ctx) name arguments)
  (-> rc:client? db:trickdb? string? jsexpr? any/c (-> (or/c symbol? string?) any/c any))
(define/contract ((call-subtrick client db context-id message parent-ctx globals) name arguments)
  (-> rc:client? db:trickdb? string? jsexpr? any/c sandbox-globals? (-> (or/c symbol? string?) any/c any))
  (let ([trick (db:get-trick db context-id (~a name))])
    (if trick
        (let ()
@@ -289,7 +299,8 @@
              db
              context-id
              (if arguments (~a arguments) "")
              parent-ctx)
              parent-ctx
              globals)
             (const #t)))
          (write-string (ev:run-result-stdout rr))
          (cond [(ev:run-result-stderr rr)
@@ -395,7 +406,6 @@
      [#t #t] ; this segment is OK! (Overly specific is ok so no need to check for (empty? rest))
      [subtree (vet-domain (rest domain) subtree)] ; Keep recursing down
)))
(define max-download-bytes 500000) ; 500 kb
(define download-thread
  (thread
   (thunk
@@ -404,17 +414,32 @@
        [message (thread-receive)]
        [result (with-handlers ([exn:fail? identity]) (let* (
          [dl-url (car message)]
          [port (get-pure-port dl-url)]
          [payload (port->bytes port)]
          [amt (bytes-length payload)]
          [_ (if (< amt max-download-bytes) 
            #t 
            (error (~a "got too many bytes (" amt ") from download (max is " max-download-bytes ")")))])
          payload))])
          [port (get-pure-port dl-url)])
          (port->bytes port)))])
        (channel-put (cdr message) result))
    (loop))
)))
(define/contract (checked-download dl-url-string) (-> string? bytes?) (let* (
; One execution context can only download so much!
; this function checks if the allowance is below zero and gives a consistent error message.
; this is a function because we need to check both before *and* after downloading something.
(define (check-dl-limit globals) (let (
  [allowance (sandbox-globals-download-bytes-allowance globals)])
  (if (<= 0 allowance)
    #t
    (error (~a 
      "went " 
      (- allowance) 
      " bytes over the download allowance of "
      (sandbox-globals-download-bytes-allowance (default-sandbox-globals)) 
      " bytes per sandbox")))))
(define (checked-download dl-url-string globals) (let* (
  [_ (check-dl-limit globals)]
  [_ (if (< 0 (sandbox-globals-download-times-allowance globals)) 
    #t 
    (error (~a 
      "tried to download too many times when the max is "
      (sandbox-globals-download-times-allowance (default-sandbox-globals))
      " per sandbox")))]
  [dl-url (string->url dl-url-string)]
  ; If no scheme is provided add https as convenience
  [dl-url (if (false? (url-scheme dl-url)) (struct-copy url dl-url [scheme "https"]) dl-url)]
@@ -428,11 +453,20 @@

  [_ (if vetted-ok #t (error (~a "`" domain "` is not an allowed domain in the url `" dl-url-string "`")))]
  [ch (make-channel)]
  [_ (thread-send download-thread (cons dl-url ch))])
  (channel-get ch)
))

(define (evaluation-ctx trick client message db context-id args parent-ctx)
  [_ (thread-send download-thread (cons dl-url ch))]
  [downloaded (channel-get ch)])
  ; whos dumb idea was this longass name
  (set-sandbox-globals-download-bytes-allowance! 
    globals 
    (- (sandbox-globals-download-bytes-allowance globals) 
    (bytes-length downloaded)))
  (check-dl-limit globals)
  (set-sandbox-globals-download-times-allowance!
    globals
    (sub1 (sandbox-globals-download-times-allowance globals)))
  downloaded))

(define (evaluation-ctx trick client message db context-id args parent-ctx globals)
  (let* ([placeholder (make-placeholder #f)]
         [ctx
          `((message-contents . ,(hash-ref message 'content))
@@ -450,11 +484,15 @@
            (emote-image      . ,(emote-image client))
            (delete-caller    . ,(thunk (thread-send deleter-thread (cons client message))))
            (make-attachment  . ,make-attachment)
            (call-trick       . ,(call-subtrick client db context-id message placeholder))
            (call-trick       . ,(call-subtrick client db context-id message placeholder globals))
            (message-author   . ,(message-author-id message))
            (read-storage     . ,(curry read-storage trick message))
            (write-storage    . ,(curry write-storage trick message))
            (download         . ,checked-download)
            (download         . , (curryr checked-download globals))
            (download-bytes-allowance 
                              . ,(thunk (sandbox-globals-download-bytes-allowance globals)))
            (download-times-allowance 
                              . ,(thunk (sandbox-globals-download-times-allowance globals)))
            (allowed-domains  . ,ok-domains)
            (parent-context   . ,parent-ctx))])
    (placeholder-set! placeholder (make-hash ctx))
diff --git a/scribblings/r16.scrbl b/scribblings/r16.scrbl
index 516b5c4..d1d64ee 100644
--- a/scribblings/r16.scrbl
+++ b/scribblings/r16.scrbl
@@ -76,6 +76,8 @@ Thunk that deletes the message that invoked this sandbox.

@defproc[(download [url string?]) bytes?]{
Downloads data from the given URL and returns it as bytes.
Each sandbox only has a certain amount of bytes it can download, and you can only call
@racket[download] so many times per sandbox.

Only certain domains are allowed in the URL; look at @racket[allowed-domains] for more info.
}
@@ -92,6 +94,16 @@ The tree is from right-to-left; to vet @racket[cdn.discord.com], you would check
then check @racket[discord] in the found sub-tree, and then check @racket[cdn].
}

@defproc[(download-bytes-allowance) integer?]{
Thunk that returns the number of bytes left for the sandbox to @racket[download].
This may be negative if the most recent download was for more bytes than the remaining
allowance.
}

@defproc[(download-times-allowance) integer?]{
Thunk that returns the number of times remaining the sandbox can @racket[download].
}

@defthing[parent-context (or/c (hash/c symbol? any/c) #f)]{
Mapping of all the above symbols for the trick calling this one, or @racket[#f] if this trick is the top level invocation.
}
-- 
2.32.0.windows.2