Use git and filesystem as data back-end

This commit is contained in:
Tom Willemse 2013-11-18 01:03:10 +01:00
parent 96bfb88a5e
commit 9788df48a9
5 changed files with 115 additions and 81 deletions

111
hypo.hy
View file

@ -15,11 +15,12 @@
;; You should have received a copy of the GNU Affero General Public ;; You should have received a copy of the GNU Affero General Public
;; License along with Hypo. If not, see <http://www.gnu.org/licenses/>. ;; License along with Hypo. If not, see <http://www.gnu.org/licenses/>.
(import web sys os hashlib datetime (import web sys os hashlib datetime shutil
[pygments [highlight]] [pygments [highlight]]
[pygments.lexers [get-lexer-by-name guess-lexer-for-filename]] [pygments.lexers [get-lexer-by-name guess-lexer-for-filename]]
[pygments.formatters [HtmlFormatter]] [pygments.formatters [HtmlFormatter]]
[pygments.util [ClassNotFound]]) [pygments.util [ClassNotFound]]
[gittle [Gittle]])
(try (import [config [*]]) (try (import [config [*]])
(catch [ImportError] (catch [ImportError]
@ -33,9 +34,6 @@
(+ "/" *prefix* "dl/(.*)") "download" (+ "/" *prefix* "dl/(.*)") "download"
(+ "/" *prefix* "([a-f0-9]{7})$") "html" (+ "/" *prefix* "([a-f0-9]{7})$") "html"
(+ "/" *prefix* "(.*)") "upload")) (+ "/" *prefix* "(.*)") "upload"))
(def db
(kwapply (web.database)
{"dbn" "postgres" "user" *dbuser* "pw" *dbpw* "db" *dbname*}))
(defun hashes [name] (defun hashes [name]
(let ((hasher (hashlib.sha1))) (let ((hasher (hashlib.sha1)))
@ -59,11 +57,6 @@
(setv web.ctx.status (str "404 Not Found")) (setv web.ctx.status (str "404 Not Found"))
"No such file.\n") "No such file.\n")
(defun get-file [name]
(let ((res (kwapply (db.select "hfile" {"shash" name})
{"where" "shash = $shash"})))
(if res (car res))))
(defun get-lexer [filename content] (defun get-lexer [filename content]
"Try to guess the correct lexer by FILENAME and CONTENT. "Try to guess the correct lexer by FILENAME and CONTENT.
@ -74,67 +67,77 @@ If no lexer is found fallback onto the text lexer."
(defclass raw [] (defclass raw []
[[GET (lambda [self name] [[GET (lambda [self name]
(let ((filename (+ "files/" name)) (let ((dirname (+ "files/" (os.path.dirname name)))
(resp (if (os.path.exists filename) (repo (and (os.path.exists dirname)
(read-file filename)))) (Gittle dirname)))
(resp (if repo
(get (.commit-file
repo "HEAD" (os.path.basename name))
"data"))))
(or resp (no-such-file))))]]) (or resp (no-such-file))))]])
(defclass download [] (defclass download []
[[GET (lambda [self name] [[GET (lambda [self name]
(let ((hfile (get-file name)) (let ((dirname (+ "files/" (os.path.dirname name)))
(filename (+ "files/" name))) (repo (and (os.path.exists dirname)
(if (and hfile (os.path.exists filename)) (Gittle dirname))))
(if repo
(progn (progn
(web.header "Content-Disposition" (web.header "Content-Disposition"
(+ "attachment; filename=\"" (+ "attachment; filename=\"" name "\""))
hfile.filename "\"")) (get (.commit-file repo "HEAD"
(read-file filename)) (os.path.basename name)) "data"))
(no-such-file))))]]) (no-such-file))))]])
(defun render-file [hash repo ref filename]
(if (not (os.path.isdir filename))
(let ((content (get (.commit-file repo ref filename) "data"))
(lexer (get-lexer filename content))
(formatter (HtmlFormatter))
(args {"file" filename "hash" hash}))
(.update
args (if (in (get (os.path.splitext filename) 1)
[".png" ".jpg" ".jpeg" ".gif"])
{"content" (kwapply (render.image)
{"name" filename
"hash" hash})
"style" ""}
{"content" (highlight content lexer formatter)
"style" (formatter.get-style-defs ".highlight")}))
(kwapply (render.main) args))
""))
(defclass html [] (defclass html []
[[GET (lambda [self name] [[GET (lambda [self name]
(let ((hfile (get-file name)) (let ((dirname (+ "files/" name))
(filename (+ "files/" name))) (repo (and (os.path.exists dirname)
(if (and hfile (os.path.exists filename)) (Gittle dirname))))
(cond (if repo
((= hfile.type "text") (car (list-comp (render-file name repo "HEAD" f)
(progn [f (.iterkeys (.commit-tree repo "HEAD"))]
(let ((content (read-file filename)) (not (or (= f ".")
(lexer (get-lexer hfile.filename content)) (= f "..")))))
(formatter (HtmlFormatter)))
(kwapply (render.main)
{"content" (highlight content lexer
formatter)
"style" (formatter.get-style-defs
".highlight")
"file" hfile})
)))
((= hfile.type "image")
(kwapply (render.main)
{"content" (kwapply (render.image)
{"name" name})
"style" ""
"file" hfile})))
(no-such-file))))] (no-such-file))))]
[DELETE (lambda [self name] [DELETE (lambda [self name]
(let ((filename (+ "files/" name))) (let ((dirname (+ "files/" name)))
(kwapply (db.delete "hfile") (if (os.path.exists dirname)
{"where" (+ "shash = '" name "'")}) (shutil.rmtree dirname)
(if (os.path.exists filename)
(os.remove filename)
(no-such-file))))]]) (no-such-file))))]])
(defclass upload [] (defclass upload []
[[PUT (lambda [self name] [[PUT (lambda [self name]
(let ((h (hashes name))) (let ((h (hashes name))
(with [f (file (+ "files/" (get h 0)) "w")] (dirname (+ "files/" (get h 0))))
(os.mkdir dirname)
(with [f (file (+ dirname "/" name) "w")]
(.write f (web.data))) (.write f (web.data)))
(kwapply (db.insert "hfile") (let ((repo (Gittle.init dirname)))
{"shash" (get h 0) (.stage repo [(str name)])
"hash" (get h 1) (kwapply (repo.commit)
"filename" name {"name" "Hypo"
"type" (get-type (get (os.path.splitext name) 1))}) "email" "hypo@ryuslash.org"
"message" "Initial commit"}))
(setv web.ctx.status (str "201 Created")) (setv web.ctx.status (str "201 Created"))
(+ web.ctx.home "/" *prefix* (get h 0) "\n")))]]) (+ web.ctx.home "/" *prefix* (get h 0) "\n")))]])
@ -142,6 +145,6 @@ If no lexer is found fallback onto the text lexer."
[[GET (lambda [self] (render.index))]]) [[GET (lambda [self] (render.index))]])
(defun hypo-start [argv] (defun hypo-start [argv]
(let ((sys.argv (cdr sys.argv)) (let ((sys.argv argv)
(app (web.application urls (globals)))) (app (web.application urls (globals))))
(.run app))) (.run app)))

17
hypoctl
View file

@ -18,21 +18,6 @@
(import pycommand sys web os (import pycommand sys web os
[hypo [hypo-start]]) [hypo [hypo-start]])
(try (import [config [*]])
(catch [ImportError]
(print "Please copy the config.example.hy to config.hy and set"
"the values to your preference.")
(sys.exit 1)))
(def db
(kwapply (web.database)
{"dbn" "postgres" "user" *dbuser* "pw" *dbpw* "db" *dbname*}))
(defun hypo-purge [argv]
(db.delete "hfile" "TRUE")
(foreach [f (os.listdir "files/")]
(os.remove (os.path.join "files" f))))
(defclass hypoctl-command (pycommand.CommandBase) (defclass hypoctl-command (pycommand.CommandBase)
[[usagestr "usage: hypoctl <command> [<args]"] [[usagestr "usage: hypoctl <command> [<args]"]
[description "Control hypo"] [description "Control hypo"]
@ -40,8 +25,6 @@
(cond (cond
((not self.args) ((not self.args)
(progn (print self.usage) 2)) (progn (print self.usage) 2))
((= (car self.args) "purge")
(hypo-purge (cdr self.args)))
((= (car self.args) "start") ((= (car self.args) "start")
(hypo-start (cdr self.args))) (hypo-start (cdr self.args)))
(True (True

View file

@ -1,4 +1,4 @@
$def with (name) $def with (name, hash)
$# Hypo -- Quickly share stuff $# Hypo -- Quickly share stuff
$# Copyright (C) 2013 Tom Willemse $# Copyright (C) 2013 Tom Willemse
$# $#
@ -15,6 +15,6 @@ $#
$# You should have received a copy of the GNU Affero General Public $# You should have received a copy of the GNU Affero General Public
$# License along with Hypo. If not, see <http://www.gnu.org/licenses/>. $# License along with Hypo. If not, see <http://www.gnu.org/licenses/>.
<a href="raw/$name"> <a href="raw/$hash/$name">
<img src="raw/$name" alt="$name"> <img src="raw/$hash/$name" alt="$name">
</a> </a>

View file

@ -1,4 +1,4 @@
$def with (content, style, file) $def with (content, style, file, hash)
$# Hypo -- Quickly share stuff $# Hypo -- Quickly share stuff
$# Copyright (C) 2013 Tom Willemse $# Copyright (C) 2013 Tom Willemse
$# $#
@ -17,7 +17,7 @@ $# License along with Hypo. If not, see <http://www.gnu.org/licenses/>.
<!DOCTYPE html> <!DOCTYPE html>
<html> <html>
<head> <head>
<title>Hypo: $file.filename</title> <title>Hypo: $file</title>
<link href="//cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/2.3.2/css/bootstrap.min.css" <link href="//cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/2.3.2/css/bootstrap.min.css"
type="text/css" rel="stylesheet" /> type="text/css" rel="stylesheet" />
<style>$:style</style> <style>$:style</style>
@ -27,15 +27,15 @@ $# License along with Hypo. If not, see <http://www.gnu.org/licenses/>.
<div class="navbar navbar-static-top navbar-inverse"> <div class="navbar navbar-static-top navbar-inverse">
<div class="navbar-inner"> <div class="navbar-inner">
<a class="brand">Hypo</a> <a class="brand">Hypo</a>
<ul class="nav">
<li><a href="raw/$file.shash">Raw</a></li>
<li><a href="dl/$file.shash">Download</a></li>
</ul>
</div> </div>
</div> </div>
<div class="container"> <div class="container">
<h1>$file.filename</h1> <h1>
$file
<a href="raw/$hash/$file"><i class="icon-file"></i></a>
<a href="dl/$hash/$file"><i class="icon-download"></i></a>
</h1>
<div class="row">$:content</div> <div class="row">$:content</div>

48
upgrade-git.hy Executable file
View file

@ -0,0 +1,48 @@
#!/usr/bin/env hy
;; Hypo -- Quickly share stuff
;; Copyright (C) 2013 Tom Willemse
;; Hypo is free software: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;; Hypo is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General
;; Public License for more details.
;; You should have received a copy of the GNU Affero General Public
;; License along with Hypo. If not, see <http://www.gnu.org/licenses/>.
(import web os
[gittle [Gittle]])
(try (import [config [*]])
(catch [ImportError]
(print "Please copy the config.example.hy to config.hy and set"
"the values to your preference.")
(sys.exit 1)))
(def db
(kwapply (web.database)
{"dbn" "postgres" "user" *dbuser* "pw" *dbpw* "db" *dbname*}))
(defun get-file [name]
(let ((res (kwapply (.select db "hfile" {"shash" name})
{"where" "shash = $shash"})))
(if res (car res))))
(foreach [f (os.listdir "files/")]
(let ((file (get-file f)))
(os.rename (+ "files/" f)
(+ "files/" file.filename))
(os.mkdir (+ "files/" f))
(os.rename (+ "files/" file.filename)
(+ "files/" f "/" file.filename))
(let ((repo (Gittle.init (+ "files/" f))))
(.stage repo [(str file.filename)])
(kwapply (repo.commit)
{"name" "System"
"email" "tom@ryuslash.org"
"message" "Initial commit for upgrade to git"}))))