Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Fix acceptor protocol for newer hunchentoot.

No longer uses a :dispatcher keyword initarg, but implements a
acceptor-dispatch-request method.
  • Loading branch information...
commit d1bda0754f84af883875bb96602c5cc43cf597c1 1 parent d0a8da7
@antifuchs authored
Showing with 32 additions and 5 deletions.
  1. +22 −5 jofrli-web.lisp
  2. +10 −0 redis-based-redirector.lisp
View
27 jofrli-web.lisp
@@ -6,10 +6,10 @@
())
(defun start (&key (redirect-port 6969) (host nil))
- (hunchentoot:start (make-instance 'jofrli-acceptor :port redirect-port :address host
- :request-dispatcher 'dispatch-redirection)))
+ (hunchentoot:start (make-instance 'jofrli-acceptor :port redirect-port :address host)))
(defmethod hunchentoot:handle-request :around ((acceptor jofrli-acceptor) request)
+ (declare (ignore request))
(redis:with-connection ()
(call-next-method)))
@@ -27,7 +27,7 @@
(babel:octets-to-string (babel:string-to-octets (subseq (puri:uri-path uri) 1) :encoding :latin-1)
:encoding :utf-8)))))
-(defun dispatch-redirection (request)
+(defmethod hunchentoot:acceptor-dispatch-request ((acceptor jofrli-acceptor) request)
(let* ((hash (extract-hash (hunchentoot:host) (hunchentoot:request-uri*))))
(labels ((send-404 ()
(setf (hunchentoot:return-code*) 404)
@@ -48,7 +48,7 @@
(format nil "~@[~a.~]~a~@[:~A~]" id (puri:uri-host *base-url*) (puri:uri-port *base-url*)))
(hunchentoot:define-easy-handler (shorten :uri "/shorten") (api-key url)
- (setf (hunchentoot:content-type*) "text/plain; charset=utf-8")
+ (setf (hunchentoot:content-type*) "text/plain; charset=utf-8")
(cond
((authorized-p api-key)
(let* ((hash (intern-url url)))
@@ -73,4 +73,21 @@
(:p "(Authorized users only, please)")
(:a :href "http://github.com/antifuchs/jofrli"
"(source code)")))
- (values)))
+ (values)))
+
+(hunchentoot:define-easy-handler (list-url-handler :uri "/list") (api-key)
+ (unless (authorized-p api-key)
+ (setf (hunchentoot:return-code*) 404)
+ (return-from list-url-handler nil))
+ (With-html-output-to-string (s)
+ (:html (:head (:title "Jo Frly: URLs"))
+ (:body
+ (:table
+ (:tr (:th "ID") (:th "URL") (:th "ToAscii") (:th "visits"))
+ (dolist (urlspec (sort (list-urls) #'> :key (lambda (spec) (getf spec :visits))))
+ (destructuring-bind (&key url id visits idn &allow-other-keys) urlspec
+ (htm
+ (:tr (:td (str id))
+ (:td (str url))
+ (:td (str idn))
+ (:td (str visits)))))))))))
View
10 redis-based-redirector.lisp
@@ -119,6 +119,16 @@
(redis:bgsave)
url))
+;;; Introspection
+
+(defun list-urls ()
+ (let ((idns (make-hash-table :test #'equal)))
+ (loop for (idn id) on (redis:hgetall "aliases") by #'cddr
+ do (setf (gethash id idns) idn))
+ (loop for (url id) on (redis:hgetall "hashed-urls") by #'cddr
+ for visits = (redis:llen (visit-key id))
+ collect (list :url url :id id :visits visits :idn (gethash id idns)))))
+
;;; API authorization
(defun authorized-p (authkey)

2 comments on commit d1bda07

@syntacticsugar

this repo is incredibly impressive and charming!!!!!!!!!!!!

@antifuchs
Owner

Thanks so much for the compliments! I'm very glad you like it (-:

Please sign in to comment.
Something went wrong with that request. Please try again.