Hunchentoot: Why can't I get the session-value? - common-lisp

Not really a CL nor a Web programming expert, so may be I'm missing something really obvious: I try to set a session-value in page-1 and fetch the result in page-2. Nothing is displayed in page-2, though...
(ql:quickload "cl-who")
(ql:quickload "hunchentoot")
(defpackage :sessmin
(:use :cl :cl-who :hunchentoot))
(in-package :sessmin)
(defun start-server (port)
(start (make-instance 'easy-acceptor :port port)))
(setf (html-mode) :html5)
(define-easy-handler (page1 :uri "/page1") ()
(start-session)
(setf (session-value :sv) "testvalue")
(with-html-output-to-string
(*standard-output* nil :prologue t :indent t)
(:html :lang "en"
(:head
(:meta :charset "utf-8")
(:title "page1"))
(:body
(:p "Session Page 1")
(:p "Go to next page" (:a :href "page2" "here"))))))
(define-easy-handler (page2 :uri "/page2") ()
(with-html-output-to-string
(*standard-output* nil :prologue t :indent t)
(:html :lang "en"
(:head
(:meta :charset "utf-8")
(:title "page2"))
(:body
(:p "Session Page 2")
(:p "Session Page 2, value:" (session-value :sv))))))
(start-server 8080)
EDIT: Got the "("s wrong in my first version, still does not work after correction though...

Your problem is not that the session value is not set, but in your cl-who format.
(:p "Session Page 2, value:" (session-value :sv))
will not print the session value; the return value of session-value is simply ignored.
;; try this:
(:p "Session Page 2, value:" (str (session-value :sv)))
;; or, if you need to html-escape the value,
(:p "Session Page 2, value:" (esc (session-value :sv)))

Not a Hunchentoot expert, but I think you forgot to close :head.

Related

Size of uploaded video is 0 on the server, even though the video has a size

I have the following re-frame event handlers with which I’m trying to upload a video to the server:
(reg-event-fx
:upload-shot-video-server
(fn [coeffects [_ blob]]
(let [body (js/FormData.)]
(.append body "video" blob)
{:http-xhrio {:method :post
:uri (str "http://d18a6571c2e5.ngrok.io" "/api/upload-shot-video")
:body body
:on-success [:upload-success]
:on-failure [:upload-error]
:response-format (edn/edn-response-format)}}))
)
(reg-event-fx
:upload-shot-video
(fn [coeffects _]
(prn "uploading video")
(let [response (js/fetch (-> coeffects :db :shot-video-uri))]
(try
(go
(let [blob (<p! (. (<p! response) blob))]
(js/console.log "blob is " blob)
(js/console.log "size of blob is " (.-size blob))
(dispatch [:upload-shot-video-server blob])))
(catch js/Error e (js/console.log "Error is " e)))
{})))
I have a handler on the server to take the input stream and save it as a file:
(defn upload-shot-video [req]
(prn "uploading video")
(prn "video is! " (-> req :params))
(prn "video is " (-> req :body))
(clojure.java.io/copy (-> req :body) (clojure.java.io/file "./resources/public/video.mov"))
(let [filename (str (rand-str 100) ".mov")]
(s3/put-object
:bucket-name "humboi-videos"
:key filename
:file "./resources/public/video.mov"
:access-control-list {:grant-permission ["AllUsers" "Read"]})
(db/add-video {:name (-> req :params :name)
:uri (str "https://humboi-videos.s3-us-west-1.amazonaws.com/" filename)}))
(r/response {:res "okay!"}))
However, the video that’s being saved as a file is 0 bytes large, even though the video blob is a non-zero sized video.
How to fix this error?
Could it be your server refusing big file sizes? I was using org.httpkit.server and it would silently refuse post with files above 8MB. I solved it like this:
(server/run-server app {:port your-port-number :max-body 128000000})) ;128MB

Clojure Cross Origin Error - Totally Lost

I have the following simple server in Clojure using Compojure (which is some flavor of the ring pattern). Everything was working fine in development, and now that I'm in prod I can't get CORS to work for the life of me - I have a wrap-preflight function which seems to work fine, but I keep getting CORS errors in terminal and neither the post or get requests for my comment system work. I am totally lost and very frustrated, I've asked around and no one else seems to know.
Here is the main core.clj code - If anyone has any ideas please let me know. You can see the errors live at thedailyblech.com (not an advert, but maybe it will help debug).
Thank you!
(ns clojure-play.core
(:use org.httpkit.server
[compojure.core :refer :all]
[compojure.route :as route]
[clojure.data.json :as json]
[clojure.tools.logging :only [info]]
[clojure-play.routes :as routes]
[ring.middleware.json :only [wrap-json-body]]
[ring.middleware.cors :refer [wrap-cors]])
(:require [monger.core :as mg]
[monger.collection :as mc]
[clojure.edn :as edn]
[clojure.java.io :as io]
[compojure.handler :as handler])
(:import [org.bson.types ObjectId]
[com.mongodb DB WriteConcern])
(:gen-class))
(println "in the beginning was the command line...")
(defonce channels (atom #{}))
(defn connect! [channel]
(info "channel open")
(swap! channels conj channel))
(defn notify-clients [msg]
(doseq [channel #channels]
(send! channel msg)))
(defn disconnect! [channel status]
(info "channel closed:" status)
(swap! channels #(remove #{channel} %)))
(defn ws-handler [request]
(with-channel request channel
(connect! channel)
(on-close channel (partial disconnect! channel))
(on-receive channel #(notify-clients %))))
(defn my-routes [db]
(routes
(GET "/foo" [] "Hello Foo")
(GET "/bar" [] "Hello Bar")
(GET "/json_example/:name" [] routes/json_example)
(GET "/json_example" [] routes/json_example)
(POST "/email" [] routes/post_email)
(POST "/write_comment" [] (fn [req] (routes/write_comment req db)))
(POST "/update_comment" [] (fn [req] (routes/update_comment req db)))
(GET "/read_comments/:path" [path] (fn [req] (routes/read_comments req db path)))
(GET "/read_comments/:path1/:path2" [path1 path2] (fn [req] (routes/read_comments req db (str path1 "/" path2))))
(GET "/ws" [] ws-handler)))
(defn connectDB []
(defonce connection
(let
[uri "mongodb://somemlabthingy"
{:keys [conn db]} (mg/connect-via-uri uri)]
{:conn conn
:db db}))
{:db (:db connection)
:conn (:conn connection)})
(def cors-headers
"Generic CORS headers"
{"Access-Control-Allow-Origin" "*"
"Access-Control-Allow-Headers" "*"
"Access-Control-Allow-Methods" "GET POST OPTIONS DELETE PUT"})
(defn preflight?
"Returns true if the request is a preflight request"
[request]
(= (request :request-method) :options))
(defn -main
"this is main"
[& args]
(println "hello there main")
(def db (get (connectDB) :db))
(println (read-string (slurp (io/resource "environment/config.edn"))))
(defn wrap-preflight [handler]
(fn [request]
(do
(println "inside wrap-preflight")
(println "value of request")
(println request)
(println "value of handler")
(println handler)
(if (preflight? request)
{:status 200
:headers cors-headers
:body "preflight complete"}
(handler request)))))
(run-server
(wrap-preflight
(wrap-cors
(wrap-json-body
(my-routes db)
{:keywords? true :bigdecimals? true})
:access-control-allow-origin [#"http://www.thedailyblech.com"]
:access-control-allow-methods [:get :put :post :delete :options]
:access-control-allow-headers ["Origin" "X-Requested-With"
"Content-Type" "Accept"]))
{:port 4000}))
The CORS middleware handles the preflight stuff automatically -- you do not need separate middleware for it, nor do you need to produce your own headers etc.
You have it wrapping the routes which is correct -- so CORS-checking happens first, then routing. You should remove your custom preflight middleware and it should work at that point.
We use wrap-cors at work and the only complication we hit was in allowing enough headers (some inserted by production infrastructure, like load balancers). We ended up with this:
:access-control-allow-headers #{"accept"
"accept-encoding"
"accept-language"
"authorization"
"content-type"
"origin"}
For what it's worth, here's what we have for methods:
:access-control-allow-methods [:delete :get
:patch :post :put]
(you do not need :options in there)
After digging around for hours, I found this to be super helpful on an issues post on the ring-cors github, for which documentation was severely lacking.
Using the linked gist, I was able to get past the CORS issues:
; Copied from linked gist
(def cors-headers
"Generic CORS headers"
{"Access-Control-Allow-Origin" "*"
"Access-Control-Allow-Headers" "*"
"Access-Control-Allow-Methods" "GET"})
(defn preflight?
"Returns true if the request is a preflight request"
[request]
(= (request :request-method) :options))
(defn all-cors
"Allow requests from all origins - also check preflight"
[handler]
(fn [request]
(if (preflight? request)
{:status 200
:headers cors-headers
:body "preflight complete"}
(let [response (handler request)]
(update-in response [:headers]
merge cors-headers )))))
; my -main
(defn -main
"Main entry point"
[& args]
(let [port (Integer/parseInt (or (System/getenv "PORT") "8081"))]
(server/run-server
(all-cors
(wrap-defaults #'app-routes site-defaults))
{:port port})
(println "Running on" port)))
This finally allowed me to see the headers properly set in Chrome dev tools and also got rid of the warning on my React front-end.
Access-Control-Allow-Headers: *
Access-Control-Allow-Methods: GET
Access-Control-Allow-Origin: *
Might be worth trying and adding an explicit
(OPTIONS "/*" req handle-preflight)
route to your Compojure routes - in my case that's what made it work.
(RING-MIDDLEWARE-CORS/wrap-cors
:access-control-allow-credentials "true"
:access-control-allow-origin [#".*"]
:access-control-allow-headers #{"accept"
"accept-encoding"
"accept-language"
"authorization"
"content-type"
"origin"}
:access-control-allow-methods [:get :put :post :delete :options])

Cannot post slack webhook url in common lisp

I wanted to post slack webhook, but I get an error.
This works:
(defun post-slack ()
(drakma:http-request "https://hooks.slack.com/services/xxx"
:method :post
:content-type "application/json"
:parameters '(("payload" . "{\"username\":\"bot\",\"icon_emoji\":\":hatching_chick:\",\"text\":\"name: ~A \n email: ~A \n content: ~A \",\"as_user\":true}"))))
But this does not:
(defun post-slack (name email text)
(setq *payload* (format nil "{\"username\":\"bot\",\"icon_emoji\":\":hatching_chick:\",\"text\":\"<#U7RM4J8MR> name: ~A \n email: ~A \n text: ~A \",\"as_user\":true}" name email text))
(drakma:http-request "https://hooks.slack.com/services/xxx"
:method :post
:content-type "application/json"
:parameters '(("payload" . *payload*))))
This is my error:
The value
CAVEMAN-STUDY.CONTROLLER::*PAYLOAD*
is not of type
LIST
when binding SB-C::FAST
[Condition of type TYPE-ERROR]
Restarts:
0: [RETRY] Retry SLIME REPL evaluation request.
1: [*ABORT] Return to SLIME's top level.
2: [ABORT] abort thread (#<THREAD "new-repl-thread" RUNNING {1008826443}>)
Backtrace:
0: (FIND-IF-NOT #<FUNCTION (LAMBDA (DRAKMA::THING) :IN DRAKMA:HTTP-REQUEST) {22D088AB}> ("payload" . CAVEMAN-STUDY.CONTROLLER::*PAYLOAD*) :KEY #<FUNCTION CDR>)
1: (DRAKMA:HTTP-REQUEST #<PURI:URI https://hooks.slack.com/services/xxxx> :METHOD :POST :CONTENT-TYPE "application/json" :PARAMETERS ("payload" . CAVEMAN-STUDY.CON..
2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (CAVEMAN-STUDY.CONTROLLER:POST-SLACK "aaa" "bbb" "ccc") #<NULL-LEXENV>)
3: (EVAL (CAVEMAN-STUDY.CONTROLLER:POST-SLACK "aaa" "bbb" "ccase"))
--more--
Please tell me how to fix it. Thanks!
You are passing (("payload" . *payload*)) to drakma:http-request,
and *payload* here is not evaluated, i.e., it is passed as a symbol,
not its value.
What you probably want is something like
(defun post-slack (name email text)
(let ((payload (format nil "..." ...)))
(drakma:http-request "https://hooks.slack.com/services/xxx"
:method :post
:content-type "application/json"
:parameters `(("payload" . ,payload)))))
Note that I replaced setq with let.
PS. You can also use (list (cons "payload" *payload*)) instead of `(("payload" . ,payload)) if you want to avoid backquote.
Since you're talking about Slack:
https://github.com/dptd/cl-slack (seems the most up to date and documented)
https://github.com/m0cchi/cl-slack
https://github.com/kkazuo/slack-client (in Quicklisp)
https://github.com/fiddlerwoaroof/slacker (most recent, no doc)
https://github.com/stryku/jasa (2017)
There are also more Slack bots.
I discovered these with quicksearch (I didn't know it was this handy).

How to enable CORS in Hunchentoot or Clack, or how to add a specific header?

The question says it all. This tutorial: https://www.html5rocks.com/en/tutorials/cors/ says to, at the very least, add a Access-Control-Allow-Origin: * header to the server's response.
My app, running Hunchentoot, doesn't return it:
<!-- GET http://127.0.0.1:9000/ -->
<!-- HTTP/1.1 200 OK -->
<!-- Date: Fri, 13 Oct 2017 23:26:58 GMT -->
<!-- Server: Hunchentoot 1.2.37 -->
<!-- Keep-Alive: timeout=20 -->
<!-- Connection: Keep-Alive -->
<!-- Transfer-Encoding: chunked -->
<!-- Content-Type: text/html;charset=utf-8 -->
<!-- Request duration: 0.004275s -->
I looked at Hunchentoot's doc and its headers.lisp file but couldn't find anything CORS-specific and didn't understand how to simply add a header.
Any help ? Thanks !
edit: I'm actually using Lucerne and Clack.
(in-package :cl-user)
(defpackage lisp-todo
(:use :cl
:lucerne)
(:export :app)
(:documentation "Main lisp-todo code."))
(in-package :lisp-todo)
adding
(defun change-headers (headers)
(setf (lack.response:response-headers *response*) headers))
C-c C-c =>
package lack.response does not exist.
or with Hunchentoot:
(setf (hunchentoot:header-out "Access-Control-Allow-Origin") "*")
the variable Hunchentoot:*reply* is unbound.
indeed this variable is defined with def-unbound.
edit2: trying with Ningle
(in-package :cl-user)
(defpackage todobackend-ningle
(:use :cl))
(in-package :todobackend-ningle)
;; blah blah blah.
(defvar *response* nil "") ;; to try the snippet below
(defun change-headers (headers)
;; (setf (lack.response:response-headers *response*) headers)) ;; => the value nil is not of type lack.response:response
(setf (lack.response:response-headers lack.response:response) headers)) ;; => unbound
(defvar *app* (make-instance 'ningle:<app>))
(change-headers '(:access-control-allow-origin "*"))
(setf (ningle:route *app* "/")
(lambda (params) ;; is that right ?
(change-headers '(:access-control-allow-origin "*"))
"Welcome to ningle!"))
Here is the code I use for Clack with Ningle, hopefully it can help you:
(defpackage ...
(:use :cl :ningle))
(in-package ...)
(defun change-headers (headers)
(setf (lack.response:response-headers *response*) headers))
(defmacro api-route (url method en-tetes &body corps)
`(setf (ningle:route *app* ,url :method ,method)
;; that's why your code doesn't work, you actually have to pass a #'function
#'(lambda (params)
(change-headers ,headers)
,#corps)))
Note : *response* comes from ningle.context, and I'm probably using it wrong, according to the comments in the file.
This macro can be used to create a route and specify headers, like this:
(api-route
"/"
:get
'(:access-control-allow-origin "*")
"Welcome!")
Remember, this is enough for a GET request, but for other verbs the browser will first hit OPTIONS. You'll have to answer it with at least those headers:
'(:access-control-allow-methods "POST" ; or any other verb(s)
:access-control-allow-origin "*"
:access-control-allow-headers "content-type")
This code comes from a small toy project of mine. You can look at the rest of it if you want, hopefully it can give you ideas. It’s nothing grand, and there probably are better ways to do it, but hey — it works.

How to interact with a process input/output in SBCL/Common Lisp

I have a text file with one sentence per line. I would like to lemmatize the worlds in each line using hunspell (-s option). Since I want to have the lemmas of each line separately, it wouldn't make sense to submit the whole text file to hunspell. I do need to send one line after another and have the hunspell output for each line.
Following the answers from How to process input and output streams in Steel Bank Common Lisp?, I was able to send the whole text file for hunspell one line after another but I was not able to capture the output of hunspell for each line. How interact with the process sending the line and reading the output before send another line?
My current code to read the whole text file is
(defun parse-spell-sb (file-in)
(with-open-file (in file-in)
(let ((p (sb-ext:run-program "/opt/local/bin/hunspell" (list "-i" "UTF-8" "-s" "-d" "pt_BR")
:input in :output :stream :wait nil)))
(when p
(unwind-protect
(with-open-stream (o (process-output p))
(loop
:for line := (read-line o nil nil)
:while line
:collect line))
(process-close p))))))
Once more, this code give me the output of hunspell for the whole text file. I would like to have the output of hunspell for each input line separately.
Any idea?
I suppose you have a buffering problem with the program you want to run. For example:
(defun program-stream (program &optional args)
(let ((process (sb-ext:run-program program args
:input :stream
:output :stream
:wait nil
:search t)))
(when process
(make-two-way-stream (sb-ext:process-output process)
(sb-ext:process-input process)))))
Now, on my system, this will work with cat:
CL-USER> (defparameter *stream* (program-stream "cat"))
*STREAM*
CL-USER> (format *stream* "foo bar baz~%")
NIL
CL-USER> (finish-output *stream*) ; will hang without this
NIL
CL-USER> (read-line *stream*)
"foo bar baz"
NIL
CL-USER> (close *stream*)
T
Notice the finish-output – without this, the read will hang. (There's also force-output.)
Python in interactive mode will work, too:
CL-USER> (defparameter *stream* (program-stream "python" '("-i")))
*STREAM*
CL-USER> (loop while (read-char-no-hang *stream*)) ; skip startup message
NIL
CL-USER> (format *stream* "1+2~%")
NIL
CL-USER> (finish-output *stream*)
NIL
CL-USER> (read-line *stream*)
"3"
NIL
CL-USER> (close *stream*)
T
But if you try this without the -i option (or similar options like -u), you'll probably be out of luck, because of the buffering going on. For example, on my system, reading from tr will hang:
CL-USER> (defparameter *stream* (program-stream "tr" '("a-z" "A-Z")))
*STREAM*
CL-USER> (format *stream* "foo bar baz~%")
NIL
CL-USER> (finish-output *stream*)
NIL
CL-USER> (read-line *stream*) ; hangs
; Evaluation aborted on NIL.
CL-USER> (read-char-no-hang *stream*)
NIL
CL-USER> (close *stream*)
T
Since tr doesn't provide a switch to turn off buffering, we'll wrap the call with a pty wrapper (in this case unbuffer from expect):
CL-USER> (defparameter *stream* (program-stream "unbuffer"
'("-p" "tr" "a-z" "A-Z")))
*STREAM*
CL-USER> (format *stream* "foo bar baz~%")
NIL
CL-USER> (finish-output *stream*)
NIL
CL-USER> (read-line *stream*)
"FOO BAR BAZ
"
NIL
CL-USER> (close *stream*)
T
So, long story short: Try using finish-output on the stream before reading. If that doesn't work, check for command line options preventing buffering. If it still doesn't work, you could try wrapping the programm in some kind of pty-wrapper.

Resources