bot that uploads mario artwork to the fediverse every 30 mins
No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.

59 líneas
2.1KB

  1. #lang racket/base
  2. (require net/http-client json net/url racket/port web-server/private/timer racket/file racket/bytes file/md5)
  3. (define server (getenv "SERVER"))
  4. (define token (getenv "TOKEN"))
  5. (define safebooru "safebooru.donmai.us")
  6. (define limit "20")
  7. (define page (number->string (random 1 350)))
  8. (define tags "mario_(series)%20-bowsette")
  9. (define pos (random 19))
  10. (define CRLF "\r\n")
  11. (define boundary (bytes->string/utf-8 (md5 (number->string (current-seconds)))))
  12. (define boundary-line (string-append "--" boundary CRLF))
  13. (define (search-safebooru)
  14. (define-values (status header response)(http-sendrecv safebooru (string-append "/posts.json?limit=" limit "&page=" page "&tags="tags ) #:ssl? #t))
  15. (define posts (read-json response))
  16. (list-ref posts pos))
  17. (define (main)
  18. (define post (search-safebooru))
  19. (define url (hash-ref post 'file_url))
  20. (define md5 (hash-ref post 'md5))
  21. (define file-ext (hash-ref post 'file_ext))
  22. (define filename (string-append md5 "." file-ext))
  23. (displayln (format "Downloading ~a" filename))
  24. (call-with-output-file filename
  25. (lambda (in) (display (port->bytes (get-pure-port (string->url url)))in))
  26. #:exists 'replace)
  27. (define data
  28. (bytes-append
  29. (string->bytes/utf-8 (string-append boundary-line "Content-Disposition: form-data; name=\"media_ids[0]\"; filename=" "\"" filename "\"" CRLF
  30. (format "Content-Type: image/~a" (if (eq? file-ext "jpg") "jpeg" "png")) CRLF CRLF))
  31. (file->bytes filename)
  32. (string->bytes/utf-8 (string-append CRLF "--" boundary "--" CRLF))))
  33. (define-values (status headers response)
  34. (http-sendrecv server (string-append "/api/v1/statuses") #:ssl? #t #:method #"POST" #:headers (list (string-append "Content-Type: multipart/form-data; boundary=" boundary) (string-append "Authorization: Bearer " token)) #:data data))
  35. (displayln (format "Uploading to ~a" server))
  36. (displayln status)
  37. (displayln (read-json response)))
  38. (main)
  39. ;define tm (start-timer-manager))
  40. ;define (loop)
  41. ;(start-timer tm 600 (upload-image))
  42. ;loop))
  43. ;loop)