<commit_before>(module status mzscheme
  (require (lib "file.ss")
           (lib "list.ss")
           (lib "string.ss")
           (lib "date.ss")
           (lib "servlet.ss" "web-server")
           (lib "servlet-structs.ss" "web-server" "servlet")
           (lib "timeouts.ss" "web-server" "managers")
           (lib "uri-codec.ss" "net")
           (lib "md5.ss"    "handin-server" "private")
           (lib "logger.ss" "handin-server" "private")
           (lib "config.ss" "handin-server" "private")
           (lib "hooker.ss" "handin-server" "private"))

  (define get-user-data
    (let ([users-file (build-path server-dir "users.ss")])
      (lambda (user)
        (get-preference (string->symbol user) (lambda () #f) #f users-file))))

  (define (clean-str s)
    (regexp-replace #rx" *$" (regexp-replace #rx"^ *" s "") ""))

  (define (aget alist key)
    (cond [(assq key alist) => cdr] [else #f]))

  (define (make-page title . body)
    `(html (head (title ,title))
           (body ([bgcolor "white"]) (h1 ((align "center")) ,title) ,@body)))

  (define (relativize-path p)
    (path->string
     (find-relative-path (normalize-path server-dir)
                         (normalize-path p))))

  (define (make-k k tag)
    (format "~a~atag=~a" k (if (regexp-match? #rx"^[^#]*[?]" k) "&" "?")
            (uri-encode tag)))

  ;; `look-for' can be a username as a string (will find "bar+foo" for "foo"),
  ;; or a regexp that should match the whole directory name (used with
  ;; "^solution" below)
  (define (find-handin-entry hi look-for)
    (let ([dir (assignment<->dir hi)])
      (and (directory-exists? dir)
           (ormap
            (lambda (d)
              (let ([d (path->string d)])
                (and (cond [(string? look-for)
                            (member look-for (regexp-split #rx" *[+] *" d))]
                           [(regexp? look-for) (regexp-match? look-for d)]
                           [else (error 'find-handin-entry
                                        "internal error: ~e" look-for)])
                     (build-path dir d))))
            (directory-list dir)))))

  (define (handin-link k user hi)
    (let* ([dir (find-handin-entry hi user)]
           [l (and dir (with-handlers ([exn:fail? (lambda (x) null)])
                         (parameterize ([current-directory dir])
                           (sort (filter (lambda (f)
                                           (and (not (equal? f "grade"))
                                                (file-exists? f)))
                                         (map path->string (directory-list)))
                                 string<?))))])
      (if (pair? l)
        (cdr (apply append
                    (map (lambda (f)
                           (let ([hi (build-path dir f)])
                             `((br)
                               (a ([href ,(make-k k (relativize-path hi))]) ,f)
                               " ("
                               ,(date->string
                                 (seconds->date
                                  (file-or-directory-modify-seconds hi))
                                 #t)
                               ")")))
                         l)))
        (list (format "No handins accepted so far for user ~s, assignment ~s"
                      user hi)))))

  (define (solution-link k hi)
    (let ([soln (and (member (assignment<->dir hi) (get-conf 'inactive-dirs))
                     (find-handin-entry hi #rx"^solution"))]
          [none `((i "---"))])
      (cond [(not soln) none]
            [(file-exists? soln)
             `((a ((href ,(make-k k (relativize-path soln)))) "Solution"))]
            [(directory-exists? soln)
             (parameterize ([current-directory soln])
               (let ([files (sort (map path->string
                                       (filter file-exists? (directory-list)))
                                  string<?)])
                 (if (null? files)
                   none
                   (apply append
                          (map (lambda (f)
                                 `((a ([href ,(make-k k (relativize-path (build-path soln f)))])
                                     (tt ,f))
                                   (br)))
                               files)))))]
            [else none])))

  (define (handin-grade user hi)
    (let* ([dir (find-handin-entry hi user)]
           [grade (and dir
                       (let ([filename (build-path dir "grade")])
                         (and (file-exists? filename)
                              (with-input-from-file filename
                                (lambda ()
                                  (read-string (file-size filename)))))))])
      (or grade "--")))

  (define (one-status-page user for-handin)
    (let* ([next (send/suspend
                  (lambda (k)
                    (make-page (format "User: ~a, Handin: ~a" user for-handin)
                      `(p ,@(handin-link k user for-handin))
                      `(p "Grade: " ,(handin-grade user for-handin))
                      `(p ,@(solution-link k for-handin))
                      `(p (a ([href ,(make-k k "allofthem")])
                            ,(format "All handins for ~a" user))))))]
           [tag (aget (request-bindings next) 'tag)])
      (if (string=? tag "allofthem")
        (all-status-page user)
        (download user tag))))

  (define (all-status-page user)
    (define (cell  . texts) `(td ([bgcolor "white"]) ,@texts))
    (define (rcell . texts) `(td ([bgcolor "white"] [align "right"]) ,@texts))
    (define (header . texts) `(td ([bgcolor "#f0f0f0"]) (big (strong ,@texts))))
    (define ((row k active?) dir)
      (let ([hi (assignment<->dir dir)])
        `(tr ([valign "top"])
           ,(apply header hi
                   (if active? `((br) (small (small "[active]"))) '()))
           ,(apply cell (handin-link k user hi))
           ,(rcell (handin-grade user hi))
           ,(apply cell (solution-link k hi)))))
    (let* ([next
            (send/suspend
             (lambda (k)
               (make-page
                (format "All Handins for ~a" user)
                `(table ([bgcolor "#ddddff"] [cellpadding "6"] [align "center"])
                   (tr () ,@(map header '(nbsp "Files" "Grade" "Solution")))
                   ,@(append (map (row k #t) (get-conf 'active-dirs))
                             (map (row k #f) (get-conf 'inactive-dirs)))))))]
           [tag (aget (request-bindings next) 'tag)])
      (download user tag)))

  (define (download who tag)
    (define (check path elts allow-active?)
      (let loop ([path path] [elts (reverse elts)])
        (let*-values ([(base name dir?) (split-path path)]
                      [(name) (path->string name)]
                      [(check) (and (pair? elts) (car elts))])
          (if (null? elts)
            ;; must be rooted in a submission directory (why build-path instead
            ;; of using `path'? -- because path will have a trailing slash)
            (member (build-path base name)
                    (get-conf (if allow-active? 'all-dirs 'inactive-dirs)))
            (and (cond [(eq? '* check) #t]
                       [(regexp? check) (regexp-match? check name)]
                       [(string? check)
                        (or (equal? name check)
                            (member check (regexp-split #rx" *[+] *" name)))]
                       [else #f])
                 (loop base (cdr elts)))))))
    (define file (build-path server-dir tag))
    (with-handlers ([exn:fail? (lambda (exn)
                                 (log-line "Status exception: ~s"  exn)
                                 (make-page "Error" "Illegal file access"))])
      ;; Make sure the user is allowed to read the requested file:
      (or (check file `(,who *) #t)
          (check file `(#rx"^solution") #f)
          (check file `(#rx"^solution" *) #f)
          (error "Boom!"))
      (log-line "Status file-get: ~s ~a" who file)
      (hook 'status-file-get `([username ,(string->symbol who)] [file ,file]))
      ;; Return the downloaded file
      (let* ([data (with-input-from-file file
                     (lambda () (read-bytes (file-size file))))]
             [html? (regexp-match? #rx"[.]html?$" (string-foldcase tag))]
             [wxme? (regexp-match? #rx#"^(?:#reader[(]lib\"read.ss\"\"wxme\"[)])?WXME" data)])
        (make-response/full 200 "Okay" (current-seconds)
          (cond [html? #"text/html"]
                [wxme? #"application/data"]
                [else  #"text/plain"])
          (list
           (make-header #"Content-Length"
                        (string->bytes/latin-1
                         (number->string (bytes-length data))))
           (make-header #"Content-Disposition"
                        (string->bytes/utf-8
                         (format "~a; filename=~s"
                                 (if wxme? "attachment" "inline")
                                 (let-values ([(base name dir?) (split-path file)])
                                   (path->string name))))))<commit_msg>show a bad-access file in the log<commit_after>(module status mzscheme
  (require (lib "file.ss")
           (lib "list.ss")
           (lib "string.ss")
           (lib "date.ss")
           (lib "servlet.ss" "web-server")
           (lib "servlet-structs.ss" "web-server" "servlet")
           (lib "timeouts.ss" "web-server" "managers")
           (lib "uri-codec.ss" "net")
           (lib "md5.ss"    "handin-server" "private")
           (lib "logger.ss" "handin-server" "private")
           (lib "config.ss" "handin-server" "private")
           (lib "hooker.ss" "handin-server" "private"))

  (define get-user-data
    (let ([users-file (build-path server-dir "users.ss")])
      (lambda (user)
        (get-preference (string->symbol user) (lambda () #f) #f users-file))))

  (define (clean-str s)
    (regexp-replace #rx" *$" (regexp-replace #rx"^ *" s "") ""))

  (define (aget alist key)
    (cond [(assq key alist) => cdr] [else #f]))

  (define (make-page title . body)
    `(html (head (title ,title))
           (body ([bgcolor "white"]) (h1 ((align "center")) ,title) ,@body)))

  (define (relativize-path p)
    (path->string
     (find-relative-path (normalize-path server-dir)
                         (normalize-path p))))

  (define (make-k k tag)
    (format "~a~atag=~a" k (if (regexp-match? #rx"^[^#]*[?]" k) "&" "?")
            (uri-encode tag)))

  ;; `look-for' can be a username as a string (will find "bar+foo" for "foo"),
  ;; or a regexp that should match the whole directory name (used with
  ;; "^solution" below)
  (define (find-handin-entry hi look-for)
    (let ([dir (assignment<->dir hi)])
      (and (directory-exists? dir)
           (ormap
            (lambda (d)
              (let ([d (path->string d)])
                (and (cond [(string? look-for)
                            (member look-for (regexp-split #rx" *[+] *" d))]
                           [(regexp? look-for) (regexp-match? look-for d)]
                           [else (error 'find-handin-entry
                                        "internal error: ~e" look-for)])
                     (build-path dir d))))
            (directory-list dir)))))

  (define (handin-link k user hi)
    (let* ([dir (find-handin-entry hi user)]
           [l (and dir (with-handlers ([exn:fail? (lambda (x) null)])
                         (parameterize ([current-directory dir])
                           (sort (filter (lambda (f)
                                           (and (not (equal? f "grade"))
                                                (file-exists? f)))
                                         (map path->string (directory-list)))
                                 string<?))))])
      (if (pair? l)
        (cdr (apply append
                    (map (lambda (f)
                           (let ([hi (build-path dir f)])
                             `((br)
                               (a ([href ,(make-k k (relativize-path hi))]) ,f)
                               " ("
                               ,(date->string
                                 (seconds->date
                                  (file-or-directory-modify-seconds hi))
                                 #t)
                               ")")))
                         l)))
        (list (format "No handins accepted so far for user ~s, assignment ~s"
                      user hi)))))

  (define (solution-link k hi)
    (let ([soln (and (member (assignment<->dir hi) (get-conf 'inactive-dirs))
                     (find-handin-entry hi #rx"^solution"))]
          [none `((i "---"))])
      (cond [(not soln) none]
            [(file-exists? soln)
             `((a ((href ,(make-k k (relativize-path soln)))) "Solution"))]
            [(directory-exists? soln)
             (parameterize ([current-directory soln])
               (let ([files (sort (map path->string
                                       (filter file-exists? (directory-list)))
                                  string<?)])
                 (if (null? files)
                   none
                   (apply append
                          (map (lambda (f)
                                 `((a ([href ,(make-k k (relativize-path (build-path soln f)))])
                                     (tt ,f))
                                   (br)))
                               files)))))]
            [else none])))

  (define (handin-grade user hi)
    (let* ([dir (find-handin-entry hi user)]
           [grade (and dir
                       (let ([filename (build-path dir "grade")])
                         (and (file-exists? filename)
                              (with-input-from-file filename
                                (lambda ()
                                  (read-string (file-size filename)))))))])
      (or grade "--")))

  (define (one-status-page user for-handin)
    (let* ([next (send/suspend
                  (lambda (k)
                    (make-page (format "User: ~a, Handin: ~a" user for-handin)
                      `(p ,@(handin-link k user for-handin))
                      `(p "Grade: " ,(handin-grade user for-handin))
                      `(p ,@(solution-link k for-handin))
                      `(p (a ([href ,(make-k k "allofthem")])
                            ,(format "All handins for ~a" user))))))]
           [tag (aget (request-bindings next) 'tag)])
      (if (string=? tag "allofthem")
        (all-status-page user)
        (download user tag))))

  (define (all-status-page user)
    (define (cell  . texts) `(td ([bgcolor "white"]) ,@texts))
    (define (rcell . texts) `(td ([bgcolor "white"] [align "right"]) ,@texts))
    (define (header . texts) `(td ([bgcolor "#f0f0f0"]) (big (strong ,@texts))))
    (define ((row k active?) dir)
      (let ([hi (assignment<->dir dir)])
        `(tr ([valign "top"])
           ,(apply header hi
                   (if active? `((br) (small (small "[active]"))) '()))
           ,(apply cell (handin-link k user hi))
           ,(rcell (handin-grade user hi))
           ,(apply cell (solution-link k hi)))))
    (let* ([next
            (send/suspend
             (lambda (k)
               (make-page
                (format "All Handins for ~a" user)
                `(table ([bgcolor "#ddddff"] [cellpadding "6"] [align "center"])
                   (tr () ,@(map header '(nbsp "Files" "Grade" "Solution")))
                   ,@(append (map (row k #t) (get-conf 'active-dirs))
                             (map (row k #f) (get-conf 'inactive-dirs)))))))]
           [tag (aget (request-bindings next) 'tag)])
      (download user tag)))

  (define (download who tag)
    (define (check path elts allow-active?)
      (let loop ([path path] [elts (reverse elts)])
        (let*-values ([(base name dir?) (split-path path)]
                      [(name) (path->string name)]
                      [(check) (and (pair? elts) (car elts))])
          (if (null? elts)
            ;; must be rooted in a submission directory (why build-path instead
            ;; of using `path'? -- because path will have a trailing slash)
            (member (build-path base name)
                    (get-conf (if allow-active? 'all-dirs 'inactive-dirs)))
            (and (cond [(eq? '* check) #t]
                       [(regexp? check) (regexp-match? check name)]
                       [(string? check)
                        (or (equal? name check)
                            (member check (regexp-split #rx" *[+] *" name)))]
                       [else #f])
                 (loop base (cdr elts)))))))
    (define file (build-path server-dir tag))
    (with-handlers ([exn:fail?
                     (lambda (exn)
                       (log-line "Status exception: ~a" (exn-message exn))
                       (make-page "Error" "Illegal file access"))])
      ;; Make sure the user is allowed to read the requested file:
      (or (check file `(,who *) #t)
          (check file `(#rx"^solution") #f)
          (check file `(#rx"^solution" *) #f)
          (error 'download "bad file access for ~s: ~a" who file))
      (log-line "Status file-get: ~s ~a" who file)
      (hook 'status-file-get `([username ,(string->symbol who)] [file ,file]))
      ;; Return the downloaded file
      (let* ([data (with-input-from-file file
                     (lambda () (read-bytes (file-size file))))]
             [html? (regexp-match? #rx"[.]html?$" (string-foldcase tag))]
             [wxme? (regexp-match? #rx#"^(?:#reader[(]lib\"read.ss\"\"wxme\"[)])?WXME" data)])
        (make-response/full 200 "Okay" (current-seconds)
          (cond [html? #"text/html"]
                [wxme? #"application/data"]
                [else  #"text/plain"])
          (list
           (make-header #"Content-Length"
                        (string->bytes/latin-1
                         (number->string (bytes-length data))))
           (make-header #"Content-Disposition"
                        (string->bytes/utf-8
                         (format "~a; filename=~s"
                                 (if wxme? "attachment" "inline")
                                 (let-values ([(base name dir?) (split-path file)])
                                   (path->string name))))))
{'fraction_non_alphanumeric': 0.1604380039224232, 'fraction_numerical': 0.0011985181956853345, 'mean_word_length': 1.3977272727272727, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 37, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 55, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7484453', 'n_tokens_mistral': 5517, 'n_tokens_neox': 5231, 'n_words': 1480}