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
;; 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.lexers [get-lexer-by-name guess-lexer-for-filename]]
[pygments.formatters [HtmlFormatter]]
[pygments.util [ClassNotFound]])
[pygments.util [ClassNotFound]]
[gittle [Gittle]])
(try (import [config [*]])
(catch [ImportError]
@ -33,9 +34,6 @@
(+ "/" *prefix* "dl/(.*)") "download"
(+ "/" *prefix* "([a-f0-9]{7})$") "html"
(+ "/" *prefix* "(.*)") "upload"))
(def db
(kwapply (web.database)
{"dbn" "postgres" "user" *dbuser* "pw" *dbpw* "db" *dbname*}))
(defun hashes [name]
(let ((hasher (hashlib.sha1)))
@ -59,11 +57,6 @@
(setv web.ctx.status (str "404 Not Found"))
"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]
"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 []
[[GET (lambda [self name]
(let ((filename (+ "files/" name))
(resp (if (os.path.exists filename)
(read-file filename))))
(let ((dirname (+ "files/" (os.path.dirname name)))
(repo (and (os.path.exists dirname)
(Gittle dirname)))
(resp (if repo
(get (.commit-file
repo "HEAD" (os.path.basename name))
"data"))))
(or resp (no-such-file))))]])
(defclass download []
[[GET (lambda [self name]
(let ((hfile (get-file name))
(filename (+ "files/" name)))
(if (and hfile (os.path.exists filename))
(let ((dirname (+ "files/" (os.path.dirname name)))
(repo (and (os.path.exists dirname)
(Gittle dirname))))
(if repo
(progn
(web.header "Content-Disposition"
(+ "attachment; filename=\""
hfile.filename "\""))
(read-file filename))
(+ "attachment; filename=\"" name "\""))
(get (.commit-file repo "HEAD"
(os.path.basename name)) "data"))
(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 []
[[GET (lambda [self name]
(let ((hfile (get-file name))
(filename (+ "files/" name)))
(if (and hfile (os.path.exists filename))
(cond
((= hfile.type "text")
(progn
(let ((content (read-file filename))
(lexer (get-lexer hfile.filename content))
(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})))
(let ((dirname (+ "files/" name))
(repo (and (os.path.exists dirname)
(Gittle dirname))))
(if repo
(car (list-comp (render-file name repo "HEAD" f)
[f (.iterkeys (.commit-tree repo "HEAD"))]
(not (or (= f ".")
(= f "..")))))
(no-such-file))))]
[DELETE (lambda [self name]
(let ((filename (+ "files/" name)))
(kwapply (db.delete "hfile")
{"where" (+ "shash = '" name "'")})
(if (os.path.exists filename)
(os.remove filename)
(let ((dirname (+ "files/" name)))
(if (os.path.exists dirname)
(shutil.rmtree dirname)
(no-such-file))))]])
(defclass upload []
[[PUT (lambda [self name]
(let ((h (hashes name)))
(with [f (file (+ "files/" (get h 0)) "w")]
(let ((h (hashes name))
(dirname (+ "files/" (get h 0))))
(os.mkdir dirname)
(with [f (file (+ dirname "/" name) "w")]
(.write f (web.data)))
(kwapply (db.insert "hfile")
{"shash" (get h 0)
"hash" (get h 1)
"filename" name
"type" (get-type (get (os.path.splitext name) 1))})
(let ((repo (Gittle.init dirname)))
(.stage repo [(str name)])
(kwapply (repo.commit)
{"name" "Hypo"
"email" "hypo@ryuslash.org"
"message" "Initial commit"}))
(setv web.ctx.status (str "201 Created"))
(+ 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))]])
(defun hypo-start [argv]
(let ((sys.argv (cdr sys.argv))
(let ((sys.argv argv)
(app (web.application urls (globals))))
(.run app)))

17
hypoctl
View file

@ -18,21 +18,6 @@
(import pycommand sys web os
[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)
[[usagestr "usage: hypoctl <command> [<args]"]
[description "Control hypo"]
@ -40,8 +25,6 @@
(cond
((not self.args)
(progn (print self.usage) 2))
((= (car self.args) "purge")
(hypo-purge (cdr self.args)))
((= (car self.args) "start")
(hypo-start (cdr self.args)))
(True

View file

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

View file

@ -1,4 +1,4 @@
$def with (content, style, file)
$def with (content, style, file, hash)
$# Hypo -- Quickly share stuff
$# Copyright (C) 2013 Tom Willemse
$#
@ -17,7 +17,7 @@ $# License along with Hypo. If not, see <http://www.gnu.org/licenses/>.
<!DOCTYPE html>
<html>
<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"
type="text/css" rel="stylesheet" />
<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-inner">
<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 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>

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"}))))