Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: jwinnenb/knucklehead
base: 50812f263d
...
head fork: jwinnenb/knucklehead
compare: e7531e4492
  • 3 commits
  • 12 files changed
  • 0 commit comments
  • 1 contributor
View
2  README.org
@@ -1,4 +1,4 @@
-Knucklehead
+#+TITLE: Knucklehead
Knucklehead is a proof of concept Remote Desktop system written in Clojure.
View
4 src/kh/client/checksum.clj
@@ -17,8 +17,8 @@
;;
(ns kh.client.checksum
- (:use clojure.contrib.io)
+ (:use [clojure.contrib.io :only (input-stream file)])
(:import org.apache.commons.codec.digest.DigestUtils))
(defn checksum [cookie path]
- (DigestUtils/md5Hex (input-stream (file path))))
+ (DigestUtils/md5Hex (input-stream (file path))))
View
2  src/kh/client/download.clj
@@ -17,7 +17,7 @@
;;
(ns kh.client.download
- (:use clojure.contrib.io))
+ (:use [clojure.contrib.io :only (input-stream file)]))
(defn download [cookie path]
View
2  src/kh/client/upload.clj
@@ -17,7 +17,7 @@
;;
(ns kh.client.upload
- (:use clojure.contrib.duck-streams))
+ (:use [clojure.contrib.io :only (copy file-str)]))
(defn upload [file dst name]
(copy (:tempfile file) (file-str dst name)))
View
19 src/kh/common/computer.clj
@@ -0,0 +1,19 @@
+(ns kh.common.computer
+ (:use kh.common.sql))
+
+(defn add-computer [name ip]
+ (c "insert khcomputer set cname='%s',cip='%s'" name ip))
+(defn delete-computer [name]
+ (c "delete from khcomputer where cname='%s'" name))
+(defn get-computer [name]
+ (q "select * from fhcomputer where cname='%s'" name))
+(defn list-computers []
+ (q "select * from khcomputer"))
+(defn rename-computer [name new-name]
+ (c "update computer set cname='%s' where cname='%s'" new-name name))
+(defn change-computer-ip [name new-ip]
+ (c "update computer set cip='%s' where cname='%s'" new-ip name))
+(defn computer-on [name]
+ (c "update computer set cavail='1' where cname='%s'" name))
+(defn computer-off [name]
+ (c "update computer set cavail='0' where cname='%s'" name))
View
10 src/kh/common/html.clj
@@ -0,0 +1,10 @@
+(ns kh.common.html
+ (:use [hiccup core page-helpers]))
+
+(defn default-page [title & body]
+ (html
+ [:head
+ [:title title]]
+ [:body
+ [:h1 title]
+ body]))
View
29 src/kh/common/sql.clj
@@ -28,24 +28,27 @@
(def db-ref (ref {}))
(defn con-db
- "Pushes the specified user information in to the db ref variable, simply provides the connection information, but doesn't really connect to the DB."
- [user pass host db]
- (dosync
- (ref-set db-ref
- {:classname "com.mysql.jdbc.Driver"
- :subprotocol "mysql"
- :subname (format "//%s:3306/%s" host db)
- :user user
- :password pass})))
+ "Pushes the specified user information in to the db ref variable, simply provides the connection information, but doesn't really connect to the DB. Currently operates on MySQL and Derby."
+ ([path]
+ (dosync
+ (ref-set db-ref
+ {:classname "org.apache.derby.jdbc.EmbeddedDriver"
+ :subprotocol "derby"
+ :subname path
+ :create true})))
+ ([user pass host db]
+ (dosync
+ (ref-set db-ref
+ {:classname "com.mysql.jdbc.Driver"
+ :subprotocol "mysql"
+ :subname (format "//%s:3306/%s" host db)
+ :user user
+ :password pass}))))
(defn escape-sql
"A simple wrapper for Apache Commons escapeSQL function."
[s] (StringEscapeUtils/escapeSql s))
-(defn unescape-sql
- "A simple wrapper for Apache Commons unescapeSQL function."
- [s] (StringEscapeUtils/unescapeSQL s))
-
(defn q
"Sends query string s to the database specified by db and returns the result."
([#^String q-str & rest]
View
9 src/kh/common/user.clj
@@ -41,10 +41,11 @@
(defn create-cookie [user]
(DigestUtils/md5Hex (str user (System/currentTimeMillis))))
-(defn set-cookie [user & cookie0]
+(defn new-cookie [user & cookie0]
(let [cookie (or (first cookie0)
(create-cookie user))]
- (c "update khuser set khcookie='%s' where khuname='%s'" cookie user)))
+ (c "update khuser set khcookie='%s' where khuname='%s'" cookie user)
+ cookie))
(defn get-cookie [user]
(first
@@ -52,4 +53,6 @@
(defn good-cookie? [user cookie]
(not (empty? (q "select * from khuser where khuname='%s' and khcookie='%s'" user cookie))))
-
+
+(defn good-pass? [user pass]
+ (not (empty? (q "select * from khuser where khuname='%s' and khpass='%s'" user pass))))
View
24 src/kh/server/computer_list.clj
@@ -0,0 +1,24 @@
+(ns kh.server.computer-list
+ (:use [hiccup core page-helpers form-helpers]
+ [kh.common computer html]))
+
+(defn computer-list-page []
+ (default-page
+ "Computer List"
+ (html
+ [:table
+ [:tr
+ [:th "State"]
+ [:th "Name"]
+ [:th "IP"]
+ [:th "Control"]]
+ (mapq
+ (fn [cell]
+ (html
+ [:tr
+ [:td (:cavail cell)]
+ [:td (:cname cell)]
+ [:td (:cip cell)]
+ [:td (link-to (str "https://" (:cip cell) ":8999/client") "Control")]]))
+ "select * from khcomputer")])))
+
View
3  src/kh/server/core.clj
@@ -18,11 +18,12 @@
(ns kh.server.core
(:use [compojure core route]
+ [kh.server login-page]
ring.adapter.jetty))
(defroutes server-core
(GET "/" [] nil)
- (GET "/login" [user pass] nil)
+ (GET "/login" [user pass] (login-page user pass))
(GET "/user/new" [user pass] nil)
(GET "/user/list" [] nil)
(GET "/user/edit" [] nil)
View
28 src/kh/server/login_page.clj
@@ -6,16 +6,36 @@
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-
+;;
;; Knucklehead 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 General Public License for more details.
-
+;;
;; You should have received a copy of the GNU General Public License
;; along with Foobar. If not, see <http://www.gnu.org/licenses/>.
;;
-(ns kh.server.login-page)
+(ns kh.server.login-page
+ (:use
+ [clojure.contrib.string :only (blank?)]
+ [hiccup core form-helpers]
+ [kh.common html user]))
+
-(defn login-page [user pass])
+(defn login-page [user pass]
+ (cond
+ (good-pass? user pass) (let [cookie (str user (new-cookie user))]
+ {:headers {"Set-Cookie" "khcookie=%s"
+ "Location" "/comp/list"}
+ :status 302})
+ (or (blank? user)
+ (blank? pass)) (default-page
+ "Login"
+ [:table
+ [:tr
+ [:td "User: "]
+ [:td [:input#uname]]]
+ [:tr
+ [:td "Pass: "]
+ [:td (password-field "pass")]]])))
View
7 src/sql/kh.sql
@@ -4,3 +4,10 @@ create table khuser (
khpass varchar (40),
khcookie varchar (40)
);
+
+drop table if exists khcomputer;
+create table khcomputer (
+ cname varchar (255) primary key,
+ cip int (4),
+ cavail int(1)
+);

No commit comments for this range

Something went wrong with that request. Please try again.