How to get handin to work with 2htdp/image?

; problem1.rkt
(require 2htdp/image)

(check-expect (myadd1 1) 2)
(define (myadd1 n) (+ n 1))

; checker.rkt
  (check: :language  '(special intermediate)
          :requires '(2htdp/image 2htdp/universe))

; I get this error when submitting with handin
; ERROR WHEN UPLOADING:
; submit-error:
; file-exists?: exists' access defined for /etc/ssl/cert.pem

presumably because 2htdp/image requires openssl for (bitmap/url url) :confounded:

I posted this in the discord and samth said to use 'overridden-collects' but I don't really understand how and I might as well ask here as well since discourse is more searchable than discord. How would I make this just work(TM)? Thanks!

1 Like

Not sure if this is the best solution but it's whats working:
(sandbox-path-permissions (append (sandbox-path-permissions) '((exists "/etc/ssl/")))) to the end of handin-server/sandbox.rkt

Relevant issue: https://groups.google.com/g/racket-users/c/hZtJtBMKTfA/m/OCoBPUnwDQAJ

To use overriden collects you set the sandbox-override-collection-paths parameter. I don't override 2htdp/image, though.

The general configuration I use is:

#lang s-exp handin-server/checker

(require handin-server/grading-utils
         handin-server/sandbox
         racket/runtime-path
         (only-in racket/list remove-duplicates))

(define-runtime-path here ".")
(define-values (base last dir?) (split-path (simplify-path here)))

(define assignment-name (path->string last))
(define markup-prefix ";;> ")

(define-runtime-path override "../overridden-collects/")

(pre: (sandbox-path-permissions
       (list*
        (list 'exists "/System")
        (list 'exists "/lib64")
        (list 'exists "/usr/lib64")
        (list 'exists "/etc/pki")
        (list 'exists "/usr/lib/ssl")
        (list 'exists (current-directory))
        (sandbox-path-permissions)))
      (sandbox-override-collection-paths (list override))
      (read-decimal-as-inexact #f))

(require "../warnings.rkt"
         "../codecontent.rkt"
         "../design-recipe-tools/check-signature.rkt"
         "../design-recipe-tools/parsing-submission.rkt"
         "../err-msg.rkt")
(define language 'lang/htdp-beginner)

(check: :language language
        :allowed-requires '(racket/runtime-config htdp/bsl/runtime 2htdp/image lang/prim 2htdp/universe)
        :eval? #t
        :output (string-append assignment-name ".rkt")
        :create-text? #t
        :textualize? #t    ;; raises exception for submissions that are not all text
        :maxwidth 102
        :coverage? #f
        :student-line
        (string-append "Handin:    " assignment-name "\n"
                       markup-prefix
                       "Author:    {Full Name}\n"
                       markup-prefix
                       "Email:     {Email}\n"
                       markup-prefix
                       "Username:  {username}\n"
                       ;; markup-prefix
                       ;; "Lab:       {Lab Section}"
                       )
        :extra-lines '()
        (update-submission-timestamp!)
        (add-header-line! (string-append "Timestamp: "
                                         (get-submission-timestamp)
                                         "\n"))
        (add-report-line! (get-submission-timestamp))

<rest of checker here>)

Here's the content of overriden-collects/2htdp/universe.rkt:

#lang racket

(require lang/prim)

(provide big-bang universe key=? key-event? mouse=? mouse-event?
         launch-many-worlds launch-many-worlds/proc
         LOCALHOST package? make-package
         bundle? make-bundle mail? make-mail
         stop-with? stop-with stop-with-w
         iworld? iworld=? iworld-name iworld1 iworld2 iworld3)

(provide-higher-order-primitive animate (create-scene))

(define (animate create-scene)
  (begin (for-each create-scene '(0 100 200))
         200))

(define-syntax-rule (big-bang e0 e ...)
  e0)

(define-syntax-rule (universe e0 e ...)
  e0)

(define (key=? k1 k2) (equal? k1 k2))

(define (key-event? k) (string? k))

(define (mouse=? m1 m2) (equal? m1 m2))

(define (mouse-event? m) (string? m))

(define-syntax-rule (launch-many-worlds e ...)
  (values e ...))

(define launch-many-worlds/proc
  (lambda thunks (apply values (map (lambda (thunk) (thunk)) thunks))))

(define LOCALHOST "127.0.0.1")

(define-struct package [world upload])

(define-struct bundle [universe mails disconnect])

(define-struct mail [iworld download])

(define-struct iworld [name])

(define (iworld=? iw1 iw2)
  (and (string=? (iworld-name iw1) (iworld-name iw2))
       (eqv? iw1 iw2)))

(define iworld1 (make-iworld "iworld1"))
(define iworld2 (make-iworld "iworld2"))
(define iworld3 (make-iworld "iworld3"))

(define-struct stop-with [w])
3 Likes