From 6a7de210dfb6cb383f6ac34fce99c969ebb13f46 Mon Sep 17 00:00:00 2001 From: Dominic Pearson Date: Fri, 5 Apr 2019 22:53:02 +0200 Subject: [PATCH] 0.1.1 --- README.md | 46 ++---- project.clj | 8 +- src/phlegyas/buffers.clj | 195 +++++++++++++++++++++++ src/phlegyas/core.clj | 88 +---------- src/phlegyas/frames.clj | 101 +++++------- src/phlegyas/reader.clj | 171 --------------------- src/phlegyas/state.clj | 168 -------------------- src/phlegyas/transformer.clj | 110 ------------- src/phlegyas/transformers.clj | 109 +++++++++++++ src/phlegyas/types.clj | 271 +++++++++++++------------------- src/phlegyas/util.clj | 44 ++---- src/phlegyas/vfs.clj | 280 ---------------------------------- test/phlegyas/frames_test.clj | 35 +++-- 13 files changed, 497 insertions(+), 1129 deletions(-) create mode 100644 src/phlegyas/buffers.clj delete mode 100644 src/phlegyas/reader.clj delete mode 100644 src/phlegyas/state.clj delete mode 100644 src/phlegyas/transformer.clj create mode 100644 src/phlegyas/transformers.clj delete mode 100644 src/phlegyas/vfs.clj diff --git a/README.md b/README.md index 588cd69..532d86c 100644 --- a/README.md +++ b/README.md @@ -1,43 +1,29 @@ # Plan 9 Filesystem Protocol, as implemented in Clojure. ```clj -[phlegyas "0.0.1-SNAPSHOT"] +[phlegyas "0.1.1"] ``` -*WARNING: DRAGONS LIE AHEAD! THIS IS WOEFULLY INCOMPLETE. USE AT YOUR OWN PERIL!* - The vast majority of the protocol-level documentation was sourced from the wonderful [Plan 9 from User Space](https://9fans.github.io/plan9port/man/man9/) project. -I have copied the test resources from [droyo's styx package](https://github.com/droyo/styx/), credit due for making it available. - -Run `lein test` to verify things work as they should. Currently, 100% of the provided framedumps are successfully handled, hopefully indicating that this is fully up to spec. - -"LISP programmers know the value of everything and the cost of nothing." Thus, I have not measured performance of the encode/decode in any serious manner, and the example state machine is a dumb single loop, likely unsuitable for any serious use. However, the principles of how to piece things together should be evident, and the design entirely customisable. - -Note the field names in `types.clj`. The `assemble-packet` function will take a map of these and create a byte-array for you. `disassemble-packet` will do the reverse. - -Development Notes: - -There are still many functions that require implementation, not least the VFS layer. Consider it unstable and subject to major changes. - -I have included a built-in TCP server in order to aid this development, accessible from the phlegyas.core namespace. +This release solely covers byte-array encoding/decoding. -Jack in with Spacemacs/CIDER with `,'` and then, at the REPL, `(r)` +I have included the test resources from [droyo's styx package](https://github.com/droyo/styx/). Run `lein test` to verify things work as they should. Currently, 100% of the provided framedumps are successfully handled, hopefully indicating that this is up to spec. -This will start a server at localhost on port 10001. +## Usage -For testing: +Keys for the frame encoding can be found in the `phlegyas.types` namespace. Check the `frame-layouts` map. There are only a few special cases, namely: +* `:Twrite` and `:Rread` frames, where the `count[4]` is automatically calculated. +* `:Twalk`, where `nwname[2]` is automatically calculated and `:wnames` should be a vector of strings. +* `:Rwalk`, where `nwqid[2]` is automatically calculated and `:nqwids` should be a vector of `{:qid-type qid.type[1] :qid-vers qid.vers[4] :qid-path qid.path[8]}` maps. +* The `qid.type[1]`, `qid.vers[4]`, `qid.path[8]` fields are named with dashes rather than dots, to make the buffer operator functions easier to resolve. -`git clone https://github.com/9fans/plan9port.git && cd plan9port && ./INSTALL` +Encoding and decoding, as done via the REPL: -Then run the built 9P FUSE client: - -`9pfuse -D 'tcp!localhost!10001' mount-point-goes-here` - -This should aid in the development cycle. - -The example VFS layer will create a single filesystem for attaching, and some example files within, with both dynamic and static content. - -There's also a few examples of callback / stream usage in the core and state namespace. +``` +phlegyas.core=> (vec (assemble-packet {:frame :Tversion :tag 0 :msize 8192 :version "9P2000"})) +[19 0 0 0 100 0 0 0 32 0 0 6 0 57 80 50 48 48 48] -When hitting inevitable issues, a simple call to `(r)` again will reset the service back to a clean state, ready to continue on your adventures. +phlegyas.core=> (disassemble-packet (byte-array [19 0 0 0 100 0 0 0 32 0 0 6 0 57 80 50 48 48 48])) +{:frame :Tversion, :tag 0, :msize 8192, :version "9P2000"} +``` diff --git a/project.clj b/project.clj index 051bb7e..79c492a 100644 --- a/project.clj +++ b/project.clj @@ -1,13 +1,9 @@ -(defproject phlegyas "0.0.1-SNAPSHOT" +(defproject phlegyas "0.1.1" :description "phlegyas: an implementation of 9P2000" :url "https://github.com/dspearson/phlegyas" :license {:name "ISC Licence"} :dependencies [[org.clojure/clojure "1.10.0"] - [org.clojure/core.async "0.4.490"] - [primitive-math "0.1.6"] - [manifold "0.1.9-alpha3"] - [aleph "0.4.6"] - [com.taoensso/timbre "4.10.0"]] + [primitive-math "0.1.6"]] :plugins [[cider/cider-nrepl "0.21.1"]] :main ^:skip-aot phlegyas.core :target-path "target/%s" diff --git a/src/phlegyas/buffers.clj b/src/phlegyas/buffers.clj new file mode 100644 index 0000000..7c1bab6 --- /dev/null +++ b/src/phlegyas/buffers.clj @@ -0,0 +1,195 @@ +(ns phlegyas.buffers + (:require [primitive-math :as math + :refer [int->uint + short->ushort + long->ulong]])) + +(defn get-tag + "Read tag[2] from the byte buffer." + [buffer] + (-> buffer .getShort short->ushort)) + +(defn get-oldtag + "Read oldtag[2] from the byte buffer." + [buffer] + (-> buffer .getShort short->ushort)) + +(defn get-msize + "Read msize[4] from the byte buffer." + [buffer] + (-> buffer .getInt int->uint)) + +(defn get-string + "Read string[s] from the byte buffer." + [buffer] + (let [string-size (-> buffer .getShort short->ushort)] + (String. (byte-array (map byte (for [i (range string-size)] (.get buffer)))) "UTF-8"))) + +(defn get-version + "Read version[s] from the byte buffer." + [buffer] + (get-string buffer)) + +(defn get-uname + "Read uname[s] from the byte buffer." + [buffer] + (get-string buffer)) + +(defn get-aname + "Read aname[s] from the byte buffer." + [buffer] + (get-string buffer)) + +(defn get-ename + "Read ename[s] from the byte buffer." + [buffer] + (get-string buffer)) + +(defn get-fid + "Read fid[4] from the byte buffer." + [buffer] + (-> buffer .getInt int->uint)) + +(defn get-newfid + "Read newfid[4] from the byte buffer." + [buffer] + (-> buffer .getInt int->uint)) + +(defn get-afid + "Read afid[4] from the byte buffer." + [buffer] + (-> buffer .getInt int->uint)) + +(defn get-perm + "Read perm[4] from the byte buffer" + [buffer] + (-> buffer .getInt int->uint)) + +(defn get-offset + "Read offset[8] from the byte buffer." + [buffer] + (-> buffer .getLong long->ulong)) + +(defn get-count + "Read count[4] from the byte buffer." + [buffer] + (-> buffer .getInt int->uint)) + +(defn get-size + "Read size[2] from the byte buffer." + [buffer] + (-> buffer .getShort short->ushort)) + +(defn get-ssize + "Read size[2] from the byte buffer. Rstat and Twstat have repeated + size field, with our ssize being +2 more than size. + + See BUGS section of stat(9) manual for more information." + [buffer] + (-> buffer .getShort short->ushort)) + +(defn get-type + "Read type[2] from the byte buffer." + [buffer] + (-> buffer .getShort short->ushort)) + +(defn get-dev + "Read dev[4] from the byte buffer." + [buffer] + (-> buffer .getInt int->uint)) + +(defn get-qid-type + "Read qid.type[1] from the byte buffer." + [buffer] + (-> buffer .get)) + +(defn get-qid-vers + "Read qid.vers[4] from the byte buffer." + [buffer] + (-> buffer .getInt int->uint)) + +(defn get-qid-path + "Read qid.path[8] from the byte buffer." + [buffer] + (-> buffer .getLong long->ulong)) + +(defn get-mode + "Read mode[4] from the byte buffer." + [buffer] + (-> buffer .getInt int->uint)) + +(defn get-atime + "Read atime[4] from the byte buffer." + [buffer] + (-> buffer .getInt int->uint)) + +(defn get-mtime + "Read mtime[4] from the byte buffer." + [buffer] + (-> buffer .getInt int->uint)) + +(defn get-length + "Read length[8] from the byte buffer." + [buffer] + (-> buffer .getLong long->ulong)) + +(defn get-name + "Read name[s] from the byte buffer." + [buffer] + (get-string buffer)) + +(defn get-uid + "Read uid[s] from the byte buffer." + [buffer] + (get-string buffer)) + +(defn get-gid + "Read gid[s] from the byte buffer." + [buffer] + (get-string buffer)) + +(defn get-muid + "Read muid[s] from the byte buffer." + [buffer] + (get-string buffer)) + +(defn get-iomode + "Read mode[1] from the byte buffer." + [buffer] + (-> buffer .get)) + +(defn get-iounit + "Read iounit[4] from the byte buffer." + [buffer] + (-> buffer .getInt int->uint)) + +(defn get-data + "Read count[4] bytes of data from the byte buffer." + [buffer] + (let [data-size (-> buffer .getInt int->uint)] + (byte-array (map byte (for [i (range data-size)] (.get buffer)))))) + +(defn get-wnames + "Read nwname[2] of wname[s] from the byte buffer." + [buffer] + (let [nwname (-> buffer .getShort short->ushort)] + (if (= nwname 0) + [] + (loop [wnames [] + count nwname] + (if (= count 0) + wnames + (recur (conj wnames (get-string buffer)) (- count 1))))))) + +(defn get-nwqids + "Read nqwid[2] of qid[13] from the byte buffer." + [buffer] + (let [nwqid (-> buffer .getShort short->ushort)] + (if (= nwqid 0) + [] + (loop [qids [] + count nwqid] + (if (= count 0) + qids + (recur (conj qids {:qid-type (get-qid-type buffer) :qid-vers (get-qid-vers buffer) :qid-path (get-qid-path buffer)}) + (- count 1))))))) diff --git a/src/phlegyas/core.clj b/src/phlegyas/core.clj index f4752b8..a666ff3 100644 --- a/src/phlegyas/core.clj +++ b/src/phlegyas/core.clj @@ -1,87 +1,3 @@ (ns phlegyas.core - (:require [phlegyas.frames :refer :all] - [phlegyas.state :refer :all] - [phlegyas.vfs :refer :all] - [phlegyas.util :refer :all] - [phlegyas.types :refer :all] - [clojure.core.async :as async] - [manifold.stream :as s] - [aleph.tcp :as tcp] - [taoensso.timbre :as log] - [primitive-math :as math - :refer [int->uint short->ushort - uint->int ushort->short - ubyte->byte byte->ubyte]])) - -(def example-mutation-stream (s/stream)) -(def state-defaults {:root-filesystem #'example-filesystem! - :mutation-stream example-mutation-stream}) - -(defn example-callback - [{:keys [state data]}] - (log/info "callback activated!") - (log/info "adding a file to the filesystem...") - (let [fs ((:root-filesystem-name state) (:fs-map state)) - file-path (swap! (:path-pool fs) inc) - synthetic-file (synthetic-file file-path - (:filename data) - "root" - "root" - 0444 - "callback!" - (fn [x] (.getBytes (:custom-data-field (:stat x)) "UTF-8")) - (sizeof-string "callback!"))] - (assoc state :fs-map (assoc (:fs-map state) - (:id fs) - (-> fs - (insert-file! file-path synthetic-file) - (update-children! (:root-path fs) file-path)))))) - -(defn add-file - [filename] - (s/put! example-mutation-stream {:fn example-callback - :data {:filename filename}})) - - -(defn server! - [in out & {:keys [state-machine initial-state] :or {state-machine #'mutate-state initial-state state-defaults}}] - (async/thread - (let [frame-stream (s/stream) - connection-id (java.util.UUID/randomUUID)] - (log/info connection-id "connection established.") - (frame-assembler in frame-stream) - (loop [state (into initial-state {:connection-id connection-id})] - (let [frame @(s/take! frame-stream)] - (log/debug "State:" state) - (if (nil? frame) - (do - (log/info connection-id "connection closed.")) - (recur (state-machine frame out state)))))))) - -(log/set-level! :info) - -(def srv nil) - -(defn tcp-route - [s info] - (let [in (s/stream) - out (s/stream) - ninep-server (server! in out)] - (s/connect s in) - (s/connect out s))) - -(defn go - [] - (def srv (tcp/start-server tcp-route {:port 10001 :join? false}))) - -(defn r - [] - (if (nil? srv) - (go) - (do - (.close srv) - (go)))) - -(defn dial - [host port] - (tcp/client {:host host :port port})) + (:require [phlegyas.frames :refer :all]) + (:gen-class)) diff --git a/src/phlegyas/frames.clj b/src/phlegyas/frames.clj index 84152f7..da72b35 100644 --- a/src/phlegyas/frames.clj +++ b/src/phlegyas/frames.clj @@ -1,85 +1,56 @@ (ns phlegyas.frames - (:require [taoensso.timbre :as log - :refer [log trace debug info warn error fatal report - logf tracef debugf infof warnf errorf fatalf reportf - spy get-env]] - [primitive-math :as math - :refer [int->uint short->ushort - uint->int ushort->short - long->ulong ulong->long]] - [clojure.core.async :as async] - [manifold.stream :as s] + (:require [phlegyas.util :refer :all] [phlegyas.types :refer :all] - [phlegyas.transformer :refer :all] - [phlegyas.util :refer :all])) + [phlegyas.transformers :refer :all])) -(defmacro flength +(defmacro frame-length "Check reported frame length." - [x] - `(if (< (.remaining ~x) 4) + [buffer] + `(if (< (.remaining ~buffer) 4) 0 - (.getInt ~x))) + (.getInt ~buffer))) -(defmacro ftype - [x] - `((keywordize (.get ~x)) '~reverse-message-type)) +(defmacro frame-type + "Look up frame type in the reverse lookup table `reverse-message-type`, + defined in the `phlegyas.types` namespace, and `keywordizes` it for us." + [buffer] + `((keywordize (.get ~buffer)) '~reverse-frame-byte)) (defn disassemble-packet + "Takes in a byte-array, and attempts to decode it. Produces a map, matching that + of the message type found in the `phlegyas.types` namespace." [packet] - (let [frame (wrap-buf packet) - len (flength frame) - typ (ftype frame) - layout (typ frame-layouts)] - (into {:frame typ} (for [msg layout] {msg ((msg type-resolvers) frame)})))) + (let [frame (wrap-buffer packet) + len (frame-length frame) + frame-typ (frame-type frame) + layout (get frame-layouts frame-typ)] + (into {:frame frame-typ} (for [typ layout] {typ ((get buffer-functions typ) frame)})))) (defn assemble "Takes in a frame and frame type, calculates the final size of the frame by adding 5, 4 bytes for the size and 1 byte for the type, looking up `type-bytes` - from the types namespace, allocating `buf` as a byte-array, wrapping it as `x`, - and using ByteBuffer operations to populate `buf`, finally returning the assembled - output." - [frame typ] - (let [frame-size (int (+ 5 (count frame))) - type-bytes (typ message-type) - buf (byte-array frame-size) - x (wrap-buf buf)] - (doto x + from the `phlegyas.types` namespace, allocating `frame-bytes` as a byte-array, wrapping + it as `buffer`, and using ByteBuffer operations to populate `frame-bytes`, finally + returning the assembled output." + [frame ftype] + (let [frame-size (+ 5 (count frame)) + type-bytes (get frame-byte ftype) + frame-bytes (byte-array frame-size) + buffer (wrap-buffer frame-bytes)] + (doto buffer (.putInt frame-size) (.put (byte type-bytes)) (.put frame)) - buf)) + frame-bytes)) (defn assemble-packet "`frame` is a map consisting of all the data required to assemble the final byte-array. - The keys required are found in the types namespace, and we get the frame layout by looking - up either in Tframe or Rframe, depending on the type of frame we are constructing. The layout - is a list of ordered items representing each element of the frame, which is optionally a pair. - When it is a pair, the second element of the pair is a STATIC value which is always used. - We feed `frame` into `transform`, which takes a frame and layout, then flatten, pack, and - finally assemble." - [frame] - (let [typ (:frame frame) - layout (typ frame-layouts) - data (into frame (for [x (typ frame-layouts)] (assoc {} x (x frame))))] - (-> data (transform layout) flatten pack (assemble typ)))) - -(defn dispatch-frame - [packet out] - (loop [x packet] - (if (< (count x) 4) - x - (let [l (-> x (subvec 0 4) byte-array wrap-buf flength)] - (if (< (count x) l) - x - (do - (s/put! out (-> x (subvec 0 l) byte-array disassemble-packet)) - (recur (subvec x l)))))))) + The keys required are found in the `phlegyas.types` namespace. The layout is a list of + ordered items representing each element of the frame. -(defn frame-assembler - [in out] - (async/thread - (loop [packet (vec @(s/take! in))] - (let [partial (dispatch-frame packet out)] - (if (s/closed? in) - (s/close! out) - (recur (vec (mapcat seq [partial @(s/take! in)])))))))) + We feed `frame` into `transform`, which takes a frame and layout, then `flatten`, `pack`, + and finally `assemble`." + [frame] + (let [ftype (:frame frame) + layout (get frame-layouts ftype)] + (-> frame (transform layout) flatten pack (assemble ftype)))) diff --git a/src/phlegyas/reader.clj b/src/phlegyas/reader.clj deleted file mode 100644 index 17d0894..0000000 --- a/src/phlegyas/reader.clj +++ /dev/null @@ -1,171 +0,0 @@ -(ns phlegyas.reader - (:require [primitive-math :as math - :refer [int->uint short->ushort - uint->int ushort->short - long->ulong ulong->long]] - [taoensso.timbre :as log])) - -(defn reader-tag - [buf] - (-> buf .getShort short->ushort)) - -(defn reader-oldtag - [buf] - (-> buf .getShort short->ushort)) - -(defn reader-msize - [buf] - (-> buf .getInt int->uint)) - -(defn reader-string - [buf] - (let [string-size (-> buf .getShort short->ushort)] - (String. (byte-array (map byte (for [i (range string-size)] (.get buf)))) "UTF-8"))) - -(defn reader-version - [buf] - (reader-string buf)) - -(defn reader-uname - [buf] - (reader-string buf)) - -(defn reader-aname - [buf] - (reader-string buf)) - -(defn reader-ename - [buf] - (reader-string buf)) - -(defn reader-qid - [buf] - (byte-array (map byte (for [i (range 0 13)] (.get buf))))) - -(defn reader-fid - [buf] - (-> buf .getInt int->uint)) - -(defn reader-newfid - [buf] - (-> buf .getInt int->uint)) - -(defn reader-afid - [buf] - (-> buf .getInt int->uint)) - -(defn reader-wname - [buf] - (let [nwname (-> buf .getShort short->ushort)] - (if (= nwname 0) - [] - (loop [wnames [] - count nwname] - (if (= count 0) - wnames - (recur (conj wnames (reader-string buf)) (- count 1))))))) - -(defn reader-mode - [buf] - (-> buf .get)) - -(defn reader-perm - [buf] - (-> buf .getInt int->uint)) - -(defn reader-offset - [buf] - (-> buf .getLong long->ulong)) - -(defn reader-count - [buf] - (-> buf .getInt int->uint)) - -(defn reader-size - [buf] - (-> buf .getShort short->ushort)) - -(defn reader-ssize - [buf] - (-> buf .getShort short->ushort)) - -(defn reader-type - [buf] - (-> buf .getShort short->ushort)) - -(defn reader-dev - [buf] - (-> buf .getInt int->uint)) - -(defn reader-qtype - [buf] - (-> buf .get)) - -(defn reader-qvers - [buf] - (-> buf .getInt int->uint)) - -(defn reader-qpath - [buf] - (-> buf .getLong long->ulong)) - -(defn reader-mode - [buf] - (-> buf .getInt int->uint)) - -(defn reader-atime - [buf] - (-> buf .getInt int->uint)) - -(defn reader-mtime - [buf] - (-> buf .getInt int->uint)) - -(defn reader-mtime - [buf] - (-> buf .getInt int->uint)) - -(defn reader-len - [buf] - (-> buf .getLong long->ulong)) - -(defn reader-name - [buf] - (reader-string buf)) - -(defn reader-uid - [buf] - (reader-string buf)) - -(defn reader-gid - [buf] - (reader-string buf)) - -(defn reader-muid - [buf] - (reader-string buf)) - -(defn reader-iomode - [buf] - (-> buf .get)) - -(defn reader-iounit - [buf] - (-> buf .getInt int->uint)) - -(defn reader-data - [buf] - (let [data-size (-> buf .getInt int->uint)] - (byte-array (map byte (for [i (range data-size)] (.get buf)))))) - -(defn reader-nwqids - [buf] - (let [nwqid (-> buf .getShort short->ushort)] - (if (= nwqid 0) - [] - (loop [qids [] - count nwqid] - (if (= count 0) - qids - (recur (conj qids {:qtype (reader-qtype buf) :qvers (reader-qvers buf) :qpath (reader-qpath buf)}) - (- count 1))))))) diff --git a/src/phlegyas/state.clj b/src/phlegyas/state.clj deleted file mode 100644 index a7d61d1..0000000 --- a/src/phlegyas/state.clj +++ /dev/null @@ -1,168 +0,0 @@ -(ns phlegyas.state - (:require [phlegyas.types :refer :all] - [phlegyas.vfs :refer :all] - [phlegyas.frames :refer :all] - [phlegyas.util :refer :all] - [manifold.stream :as s] - [manifold.deferred :as d] - [taoensso.timbre :as log])) - -;; an example state machine - -(defmacro iounit! - [] - `(- (:msize ~'state) 24)) - -(defmacro error! - [ermsg] - `(assoc ~'state :next-frame (into ~'frame {:frame :Rerror :ename ~ermsg}))) - -(defmacro state! - [data] - `(let [changed-state# (:update ~data) - reply-typ# ((keywordize (+ 1 ((:frame ~'frame) ~'message-type))) ~'reverse-message-type) - next-frame# (assoc (:reply ~data) :frame reply-typ#)] - (into (into ~'state changed-state#) {:next-frame (into ~'frame next-frame#)}))) - -(defn Tversion - [frame state] - (let [requested-message-size (:msize frame) - version-string (:version frame)] - (cond - (not (clojure.string/starts-with? version-string protocol-version)) (state! {:reply {:version "unknown"}}) - (<= requested-message-size max-message-size) (state! {:update {:msize requested-message-size} - :reply {:version protocol-version}}) - :else (state! {:update {:msize max-message-size} - :reply {:version protocol-version - :msize max-message-size}})))) - -(defn Tauth - [frame state] - (error! "no authentication required")) - -(defn Tattach - [frame state] - (let [fid (:fid frame) - fs ((:root-filesystem state)) - fs-map (assoc (:fs-map state) (:id fs) fs) - fids (set (conj (:fids state) fid)) - mapping (assoc (:mapping state) fid {:filesystem (:id fs) :path (:root-path fs)}) - role (assoc (:user state) (:id fs) {:uid (:uname frame) :gid (:uname frame)})] - (state! {:update {:fs-map fs-map - :fids fids - :root-filesystem-name (:id fs) - :mapping mapping - :role role} - :reply (path->qid fs (:root-path fs))}))) - -(defn Tflush - [frame state] - (state! {})) - -(defn Twalk - [frame state] - (let [fid (:fid frame) - newfid (:newfid frame) - wnames (:wname frame) - mapping (get (:mapping state) fid) - fs-name (:filesystem mapping) - fs (fs-name (:fs-map state)) - path (:path mapping)] - (if (= (count wnames) 0) - (state! {:update (assoc-fid state fid newfid) - :reply {:nwqid 0 :nwqids []}}) - (let [wname-paths (walk-path fs path wnames) - qids (for [p wname-paths] (stat->qid (path->stat fs p)))] - (if (empty? wname-paths) - (error! "path cannot be walked") - (state! {:update {:fids (conj (:fids state) newfid) - :mapping (assoc (:mapping state) newfid {:filesystem fs-name :path (last wname-paths)})} - :reply {:nwqid (count wname-paths) - :nwqids qids}})))))) - -(defn Topen - [frame state] - (let [mode ((keyword (str (:mode frame))) reverse-access-mode) - fid (:fid frame) - mapping (get (:mapping state) fid) - fs-name (:filesystem mapping) - fs (fs-name (:fs-map state)) - path (:path mapping) - role (fid->role fid state) - stat (path->stat fs path) - qid (stat->qid stat)] - (if (not (permission-check stat role :oread)) - (error! "no read permission") - (state! {:reply {:iounit (iounit!) - :qtype (:qtype qid) - :qvers (:qvers qid) - :qpath (:qpath qid)}})))) - -(defn Tcreate - [frame state] - (error! "not implemented")) - -(defn Tread - [frame state] - (let [offset (:offset frame) - byte-count (:count frame) - mapping (fid->mapping (:fid frame) state) - fs ((:filesystem mapping) (:fs-map state)) - stat (path->stat fs (:path mapping)) - typ (stat-type stat)] - (case typ - :qtdir (if (> offset 0) - (state! {:reply {:data nil}}) - (state! {:reply {:data {:type :directory :data (into [] (for [x (:children stat)] (path->stat fs x)))}}})) - :qtfile (if (>= offset (:len stat)) - (state! {:reply {:data nil}}) - (state! {:reply {:data ((:contents stat) {:stat stat :offset offset :count byte-count})}}))))) - -(defn Twrite - [frame state] - (error! "not implemented")) - -(defn Tclunk - [frame state] - (let [fid (:fid frame)] - (state! {:update {:fids (disj (:fids state) fid) - :mapping (dissoc (:mapping state) fid)}}))) - -(defn Tremove - [frame state] - (error! "not implemented")) - -(defn Tstat - [frame state] - (let [fid (:fid frame) - mapping (get (:mapping state) fid) - fs-name (:filesystem mapping) - fs (fs-name (:fs-map state)) - path (:path mapping) - stat (stat-file fs path)] - (state! {:reply stat}))) - -(defn Twstat - [frame state] - (error! "not implemented")) - -(def state-handlers ((fn [] (into {} (for [[k v] message-type] [k (-> k name symbol resolve)]))))) - -(defn update-state - [state mutation-message] - (cond - (nil? mutation-message) state - (not (d/realized? mutation-message)) (assoc state :mutation-message mutation-message) - :else (let [m @mutation-message - f (:fn m) - data (:data m)] - (log/info "Got a mutation message:" m) - (dissoc (f {:state state :data data}) :mutation-message)))) - -(defn mutate-state - [in out state] - (let [mutation-stream (:mutation-stream state) - mutation-message (or (:mutation-message state) (if (s/stream? mutation-stream) (s/take! mutation-stream))) - updated-state (((:frame in) state-handlers) in (update-state state mutation-message))] - (s/put! out (assemble-packet (:next-frame updated-state))) - (dissoc updated-state :next-frame))) diff --git a/src/phlegyas/transformer.clj b/src/phlegyas/transformer.clj deleted file mode 100644 index 2de2886..0000000 --- a/src/phlegyas/transformer.clj +++ /dev/null @@ -1,110 +0,0 @@ -(ns phlegyas.transformer - (:require [phlegyas.util :refer :all] - [phlegyas.types :refer :all] - [taoensso.timbre :as log] - [primitive-math :as math - :refer [int->uint short->ushort - uint->int ushort->short - ubyte->byte byte->ubyte - ulong->long long->ulong]])) - -(declare transformer) ;; required for forward declarations - -(defn transform - "Takes in data and layout and assembles it into a byte-array. - If the data requires a transformer, it looks this up in the transformer table - as defined in the transformer namespace, and executes the function on the data. - Otherwise, it lokos up the buffer operator in the type-bufop table as defined in - the types namespace, and executes this operation on the data to write to the given - byte-array by wrapping it first in a ByteBuffer." - [data layout] - (for [k layout] - (if (some? (k transformer)) - ((k transformer) (k data)) - (let [buf (byte-array (k type-size))] - ((k type-bufop) (wrap-buf buf) (k data)) - buf)))) - -(defn transform-string - [msg] - (let [string-bytes (.getBytes msg "UTF-8") - msg-size (count string-bytes) - size-buf (byte-array 2) - x (wrap-buf size-buf)] - (doto x - (.putShort msg-size)) - [size-buf string-bytes])) - -(defn transform-wname - [msg-array] - (let [size-buf (byte-array 2) - x (wrap-buf size-buf) - size (count msg-array)] - (.putShort x size) - [size-buf (for [elem msg-array] - (transform-string elem))])) - -(defn transform-nwqids - [msg] - (let [size-buf (byte-array 2) - y (wrap-buf size-buf)] - (doto y - (.putShort (count msg))) - (if (empty? msg) - size-buf - [size-buf (for [elem msg] - (let [buf (byte-array 13) - x (wrap-buf buf)] - (doto x - (.put (:qtype elem)) - (.putInt (:qvers elem)) - (.putLong (:qpath elem))) - buf))]))) - -(defn transform-raw-data - [data] - (let [size-buf (byte-array 4) - y (wrap-buf size-buf)] - (doto y - (.putInt (count data))) - [size-buf data])) - -(defn transform-directory - [data] - (let [total-size (apply + (map (fn [x] (:ssize x)) data)) - layout (subvec (:Rstat frame-layouts) 2) - size-buf (byte-array 4) - y (wrap-buf size-buf)] - (doto y - (.putInt total-size)) - [size-buf (for [entry data] (transform entry layout))])) - -(defn transform-data - [msg] - (let [typ (:type msg) - data (:data msg)] - (if (= typ :directory) - (flatten (transform-directory data)) ;instrumented directory encoder - (flatten (transform-raw-data msg))))) - -(defn transform-wdata - [msg] - (let [data-size (count msg) - size-buf (byte-array 4) - y (wrap-buf size-buf)] - (doto y - (.putInt data-size) - size-buf))) - -(def transformer {:version #'transform-string - :name #'transform-string - :uname #'transform-string - :aname #'transform-string - :muid #'transform-string - :uid #'transform-string - :gid #'transform-string - :ename #'transform-string - :wname #'transform-wname - :nwqids #'transform-nwqids - :data #'transform-data - :wdata #'transform-wdata}) diff --git a/src/phlegyas/transformers.clj b/src/phlegyas/transformers.clj new file mode 100644 index 0000000..380bda1 --- /dev/null +++ b/src/phlegyas/transformers.clj @@ -0,0 +1,109 @@ +(ns phlegyas.transformers + (:require [phlegyas.util :refer :all] + [phlegyas.types :refer :all])) + +(declare transformer) ;; required for forward declarations + +(defn transform + "Takes in data and layout and assembles it into a byte-array. + If the data requires a transformer, it looks this up in the transformer map + and executes the function on the data. + + Otherwise, it looks up the buffer operator in the `buffer-operator` map, as + defined in the `phlegyas.types` namespace, and executes this operation on + the data to write to the given byte-array by wrapping it first in a ByteBuffer." + [frame layout] + (for [typ layout] + (if (some? (get transformer typ)) + ((get transformer typ) (get frame typ)) + (let [buffer (byte-array (typ type-size))] + ((get buffer-operator typ) (wrap-buffer buffer) (get frame typ)) + buffer)))) + +(defn transform-string + "Encodes a string. Strings in 9P2000 are UTF-8, with a short field of + their length prefixing them." + [s] + (let [string-bytes (.getBytes s "UTF-8") + string-size (count string-bytes) + size-bytes (byte-array 2) + buffer (wrap-buffer size-bytes)] + (doto buffer + (.putShort string-size)) + [size-bytes string-bytes])) + +(defn transform-wnames + "Takes in a vector of wnames, for the `:Twalk` message, and encodes + them, prefixing with a short count field as required." + [coll] + (let [size-array (byte-array 2) + buffer (wrap-buffer size-array) + size (count coll)] + (.putShort buffer size) + [size-array (for [elem coll] (transform-string elem))])) + +(defn transform-nwqids + "Takes in a vector of QID structures, prefixes them with a short + count field, and encodes." + [coll] + (let [count-bytes (byte-array 2) + buffer (wrap-buffer count-bytes)] + (doto buffer + (.putShort (count coll))) + (if (empty? coll) + count-bytes + [count-bytes (for [elem coll] + (let [qid-bytes (byte-array 13) + buffer (wrap-buffer qid-bytes)] + (doto buffer + (.put (:qid-type elem)) + (.putInt (:qid-vers elem)) + (.putLong (:qid-path elem))) + qid-bytes))]))) + +(defn transform-directory + "Instrumented directory encoder. Takes in a vector of stat structures, + and produces a byte collection suitable for use in `Rread`." + [coll] + (let [calculated-size (apply + (map (fn [x] (:ssize x)) coll)) + layout (subvec (:Rstat frame-layouts) 2) + size-bytes (byte-array 4) + buffer (wrap-buffer size-bytes)] + (doto buffer + (.putInt calculated-size)) + [size-bytes (for [elem coll] (transform elem layout))])) + +(defn transform-raw-data + "Takes in a byte-array, and pads it with the size, as required by the + `Rread` and `Twrite` messages." + [data-bytes] + (let [size-bytes (byte-array 4) + buffer (wrap-buffer size-bytes)] + (doto buffer + (.putInt (count data-bytes))) + [size-bytes data-bytes])) + +(defn transform-data + "This is a special function. If you are encoding a Rread of a directory, + you can pass `:data {:type :directory :data [stat1 ... statn]}}` into + `construct-packet`, and it will also automatically encode your directory + stat structures properly. Otherwise, just pass a raw byte-array to `:data` + for it to get packed regularly." + [coll] + (let [type' (:type coll) ;; these fields are for the instrumented + data (:data coll)] ;; directory encoder. + (if (= type' :directory) + (flatten (transform-directory data)) + (flatten (transform-raw-data coll))))) + +(def transformer {:version #'transform-string + :name #'transform-string + :uname #'transform-string + :aname #'transform-string + :muid #'transform-string + :uid #'transform-string + :gid #'transform-string + :ename #'transform-string + :nwqids #'transform-nwqids + :wnames #'transform-wnames + :data #'transform-data}) diff --git a/src/phlegyas/types.clj b/src/phlegyas/types.clj index 9325925..d10279d 100644 --- a/src/phlegyas/types.clj +++ b/src/phlegyas/types.clj @@ -1,16 +1,11 @@ (ns phlegyas.types - (:require [clojure.set :refer :all] - [phlegyas.reader :refer :all] - [phlegyas.util :refer :all] - [primitive-math :as math - :refer [int->uint short->ushort - uint->int ushort->short - ubyte->byte byte->ubyte]])) - -; function lookup namespaces -(def reader "phlegyas.reader/reader-") - -; protocol defaults + (:require [phlegyas.buffers :refer :all] + [phlegyas.util :refer :all])) + +; for dynamic lookup and resolution of buffer reader functions. +(def buffer-function-prefix "phlegyas.buffers/get-") + +; protocol defaults. (def protocol-version "9P2000") (def notag 0xffff) (def nofid 0xffffffff) @@ -18,86 +13,39 @@ (def max-message-size 0x7fffffff) (def stat-keep-string "") -(def access-mode {:oread 0x00 - :owrite 0x01 - :ordrw 0x02 - :oexec 0x03 - :otrunc 0x10 - :rclose 0x40 - :oexcl 0x1000}) - -(def role-access {:oread #{:read } - :owrite #{:write } - :ordrw #{:read :write} - :oexec #{:execute } - :otrunc #{:write }}) - -(def permission-mode {:ixoth 0001 - :iwoth 0002 - :iroth 0004 - :ixgrp 0010 - :iwgrp 0020 - :irgrp 0040 - :ixusr 0100 - :iwusr 0200 - :irusr 0400}) - -(def java-permission-mode {:OWNER_EXECUTE 0100 - :OWNER_WRITE 0200 - :OWNER_READ 0400 - :GROUP_EXECUTE 0010 - :GROUP_WRITE 0020 - :GROUP_READ 0040 - :OTHERS_EXECUTE 0001 - :OTHERS_WRITE 0002 - :OTHERS_READ 0004}) - -(def file-mode {:dmdir 0x80000000 - :dmappend 0x40000000 - :dmexcl 0x20000000 - :dmtmp 0x04000000 - :dmauth 0x08000000}) - -(def qt-mode {:qtfile (byte 0) - :qtdir (byte -128) - :qtappend (byte 64) - :qtexcl (byte 32) - :qttmp (byte 4) - :qtauth (byte 8)}) - -(def message-type {:Tversion 100 - :Rversion 101 - :Tauth 102 - :Rauth 103 - :Tattach 104 - :Rattach 105 - :Rerror 107 - :Tflush 108 - :Rflush 109 - :Twalk 110 - :Rwalk 111 - :Topen 112 - :Ropen 113 - :Tcreate 114 - :Rcreate 115 - :Tread 116 - :Rread 117 - :Twrite 118 - :Rwrite 119 - :Tclunk 120 - :Rclunk 121 - :Tremove 122 - :Rremove 123 - :Tstat 124 - :Rstat 125 - :Twstat 126 - :Rwstat 127}) +(def frame-byte {:Tversion 100 + :Rversion 101 + :Tauth 102 + :Rauth 103 + :Tattach 104 + :Rattach 105 + :Rerror 107 + :Tflush 108 + :Rflush 109 + :Twalk 110 + :Rwalk 111 + :Topen 112 + :Ropen 113 + :Tcreate 114 + :Rcreate 115 + :Tread 116 + :Rread 117 + :Twrite 118 + :Rwrite 119 + :Tclunk 120 + :Rclunk 121 + :Tremove 122 + :Rremove 123 + :Tstat 124 + :Rstat 125 + :Twstat 126 + :Rwstat 127}) (def frame-layouts {:Tversion [:tag :msize :version] :Rversion [:tag :msize :version] :Tauth [:tag :afid :uname :aname] - :Rauth [:tag :aqid] + :Rauth [:tag :qid-type :qid-vers :qid-path] :Rerror [:tag :ename] @@ -105,16 +53,16 @@ :Rflush [:tag] :Tattach [:tag :fid :afid :uname :aname] - :Rattach [:tag :qtype :qvers :qpath] + :Rattach [:tag :qid-type :qid-vers :qid-path] - :Twalk [:tag :fid :newfid :wname] + :Twalk [:tag :fid :newfid :wnames] :Rwalk [:tag :nwqids] :Topen [:tag :fid :iomode] - :Ropen [:tag :qtype :qvers :qpath :iounit] + :Ropen [:tag :qid-type :qid-vers :qid-path :iounit] :Tcreate [:tag :fid :name :perm :iomode] - :Rcreate [:tag :qtype :qvers :qpath :iounit] + :Rcreate [:tag :qid-type :qid-vers :qid-path :iounit] :Tread [:tag :fid :offset :count] :Rread [:tag :data] @@ -129,81 +77,72 @@ :Rremove [:tag] :Tstat [:tag :fid] - :Rstat [:tag :ssize :size :type :dev :qtype :qvers :qpath :mode :atime :mtime :len :name :uid :gid :muid] + :Rstat [:tag :ssize :size :type :dev :qid-type :qid-vers :qid-path :mode :atime :mtime :length :name :uid :gid :muid] - :Twstat [:tag :fid :ssize :size :type :dev :qtype :qvers :qpath :mode :atime :mtime :len :name :uid :gid :muid] + :Twstat [:tag :fid :ssize :size :type :dev :qid-type :qid-vers :qid-path :mode :atime :mtime :length :name :uid :gid :muid] :Rwstat [:tag]}) -(def type-size {:tag 2 - :oldtag 2 - :msize 4 - :size 2 - :ssize 2 - :unixfd 4 - :fid 4 - :afid 4 - :newfid 4 - :nwname 2 - :nwqid 2 - :perm 4 - :iounit 4 - :offset 8 - :aqid 13 - :qid 13 - :type 2 - :dev 4 - :qtype 1 - :qvers 4 - :qpath 8 - :iomode 1 - :mode 4 - :atime 4 - :mtime 4 - :len 8 - :count 4}) - -(def type-bufop {:tag #((memfn putShort x) %1 %2) ; tag[2] - :oldtag #((memfn putShort x) %1 %2) ; oldtag[2] - :msize #((memfn putInt x) %1 %2) ; msize[4] - :version #((memfn put x) %1 %2) ; version[s] - :ename #((memfn put x) %1 %2) ; ename[s] - :uname #((memfn put x) %1 %2) ; uname[s] - :aname #((memfn put x) %1 %2) ; aname[s] - :fid #((memfn putInt x) %1 %2) ; fid[4] - :afid #((memfn putInt x) %1 %2) ; afid[4] - :newfid #((memfn putInt x) %1 %2) ; nfid[4] - :nwname #((memfn putShort x) %1 %2) ; nwname[2] - :wname #((memfn put x) %1 %2) ; wname[s] - :perm #((memfn putInt x) %1 %2) ; perm[4] - :iounit #((memfn putInt x) %1 %2) ; iounit[4] - :offset #((memfn putLong x) %1 %2) ; offset[8] - :aqid #((memfn put x) %1 %2) ; qid[13] - :nwqid #((memfn putShort x) %1 %2) ; nwqid[2] - :nwqids #((memfn put x) %1 %2) ; nwqid*qid[13] - :data #((memfn put x) %1 %2) ; count*data[1] - :iomode #((memfn put x) %1 %2) ; mode[1] - :count #((memfn putInt x) %1 %2) ; count[4] - - ;; stat[n] - :type #((memfn putShort x) %1 %2) ; type[2] - :dev #((memfn putInt x) %1 %2) ; dev[4] - :qtype #((memfn put x) %1 %2) ; qid.type[1] - :qvers #((memfn putInt x) %1 %2) ; qid.vers[4] - :qpath #((memfn putLong x) %1 %2) ; qid.path[8] - :name #((memfn put x) %1 %2) ; name[s] - :mode #((memfn putInt x) %1 %2) ; mode[4] - :atime #((memfn putInt x) %1 %2) ; atime[4] - :mtime #((memfn putInt x) %1 %2) ; mtime[4] - :len #((memfn putLong x) %1 %2) ; length[8] - :size #((memfn putShort x) %1 %2) ; size[2] - :ssize #((memfn putShort x) %1 %2) ; size[2] - :uid #((memfn put x) %1 %2) ; uid[s] - :gid #((memfn put x) %1 %2) ; gid[s] - :muid #((memfn put x) %1 %2)}) ; muid[s] - -(def type-resolvers ((fn [] (into {} (for [[k v] type-bufop] [k (-> (str reader (name k)) symbol resolve)]))))) -(def reverse-message-type (gen-lookup message-type)) -(def reverse-access-mode (gen-lookup access-mode)) -(def reverse-permission-mode (gen-lookup permission-mode)) -(def reverse-file-mode (gen-lookup file-mode)) -(def reverse-qt-mode (gen-lookup qt-mode)) +(def type-size {:tag 2 + :oldtag 2 + :msize 4 + :size 2 + :ssize 2 + :fid 4 + :afid 4 + :newfid 4 + :perm 4 + :iounit 4 + :offset 8 + :type 2 + :dev 4 + :qid-type 1 + :qid-vers 4 + :qid-path 8 + :iomode 1 + :mode 4 + :atime 4 + :mtime 4 + :length 8 + :count 4}) + +(def buffer-operator {:tag #((memfn putShort x) %1 %2) ; tag[2] + :oldtag #((memfn putShort x) %1 %2) ; oldtag[2] + :msize #((memfn putInt x) %1 %2) ; msize[4] + :fid #((memfn putInt x) %1 %2) ; fid[4] + :afid #((memfn putInt x) %1 %2) ; afid[4] + :newfid #((memfn putInt x) %1 %2) ; newfid[4] + :perm #((memfn putInt x) %1 %2) ; perm[4] + :iounit #((memfn putInt x) %1 %2) ; iounit[4] + :offset #((memfn putLong x) %1 %2) ; offset[8] + :iomode #((memfn put x) %1 %2) ; mode[1] + :count #((memfn putInt x) %1 %2) ; count[4] + + ;; stat[n] + :type #((memfn putShort x) %1 %2) ; type[2] + :dev #((memfn putInt x) %1 %2) ; dev[4] + :qid-type #((memfn put x) %1 %2) ; qid.type[1] + :qid-vers #((memfn putInt x) %1 %2) ; qid.vers[4] + :qid-path #((memfn putLong x) %1 %2) ; qid.path[8] + :name #((memfn put x) %1 %2) ; name[s] + :mode #((memfn putInt x) %1 %2) ; mode[4] + :atime #((memfn putInt x) %1 %2) ; atime[4] + :mtime #((memfn putInt x) %1 %2) ; mtime[4] + :length #((memfn putLong x) %1 %2) ; length[8] + :size #((memfn putShort x) %1 %2) ; size[2] + :ssize #((memfn putShort x) %1 %2) ; size[2] + + ;; these fields have transformers + :version nil ; version[s] + :ename nil ; ename[s] + :uname nil ; uname[s] + :aname nil ; aname[s] + :wnames nil ; count*wname[s] + :data nil ; count*data[n] + :nwqids nil ; nwqid*qid[13] + :uid nil ; uid[s] + :gid nil ; gid[s] + :muid nil}) ; muid[s] + +;; we iterate over the keys in the buffer-operator map, and resolve functions for reading them. +(def buffer-functions ((fn [] (into {} (for [[k v] buffer-operator] [k (-> (str buffer-function-prefix (name k)) symbol resolve)]))))) +(def reverse-frame-byte (reverse-map frame-byte)) diff --git a/src/phlegyas/util.clj b/src/phlegyas/util.clj index 084a00a..ef807cc 100644 --- a/src/phlegyas/util.clj +++ b/src/phlegyas/util.clj @@ -1,44 +1,26 @@ (ns phlegyas.util - (:require [primitive-math :as math - :refer [int->uint short->ushort - uint->int ushort->short]]) (:import java.nio.ByteBuffer)) -(defn sizeof-stringbuf - [s] - (+ 2 (count (.getBytes s "UTF-8")))) - -(defn sizeof-string - [s] - (count (.getBytes s "UTF-8"))) - -(defn current-seconds - [] - (-> (java.util.Date.) .getTime (quot 1000))) - -(defn new-tag - [] - (unchecked-short (rand-int 65535))) - -(defn lookup - [x table] - ((keyword (str x)) table)) - -(defn wrap-buf - [buf] - (if (nil? buf) +(defn wrap-buffer + "Wraps a byte-array in a Java ByteBuffer, using little-endian + byte order as required by the 9P2000 protocol." + [byte-array'] + (if (nil? byte-array') (ByteBuffer/wrap (byte-array 0)) - (let [buffer (ByteBuffer/wrap buf)] + (let [buffer (ByteBuffer/wrap byte-array')] (.order buffer java.nio.ByteOrder/LITTLE_ENDIAN)))) (defn pack - [x] - (byte-array (mapcat seq x))) + "Pack a sequence into a byte array." + [coll] + (byte-array (mapcat seq coll))) (defmacro keywordize + "Turn argument into a string, then a keyword." [x] `(-> ~x str keyword)) -(defmacro gen-lookup +(defmacro reverse-map + "Reverses a map, keywordizing the value." [table] - `(into {} (for [[k# v#] ~table] [(keyword (str v#)) k#]))) + `(into {} (for [[k# v#] ~table] [(keywordize v#) k#]))) diff --git a/src/phlegyas/vfs.clj b/src/phlegyas/vfs.clj deleted file mode 100644 index ec91fc5..0000000 --- a/src/phlegyas/vfs.clj +++ /dev/null @@ -1,280 +0,0 @@ -(ns phlegyas.vfs - (:require [clojure.core.async :as async] - [clojure.java.io :as io] - [phlegyas.types :refer :all] - [phlegyas.util :refer :all] - [primitive-math :as math - :refer [int->uint short->ushort - uint->int ushort->short - long->ulong ulong->long]] - [taoensso.timbre :as log]) - (:import [java.nio.file Files LinkOption] - [java.nio.file.attribute BasicFileAttributes PosixFilePermission PosixFilePermissions PosixFileAttributes])) - -;; an example VFS layer - -(defrecord stat - [dev qtype qvers qpath mode atime mtime len name size ssize uid gid muid children contents permissions parent]) - -(defrecord qid - [qtype qvers qpath]) - -(defrecord filesystem - [files path-pool id root-path]) - -(defn stat->qid - [stat] - (map->qid {:qtype (:qtype stat) :qvers (:qvers stat) :qpath (:qpath stat)})) - -(defn version - [stat] - (hash (:mtime stat))) - -(defn attrs - [fh] - (-> fh .toPath (Files/readAttributes PosixFileAttributes (into-array [LinkOption/NOFOLLOW_LINKS])))) - -(defn modification-time - [fh] - (-> fh .lastModified (/ 1000) int)) - -(defn access-time - [fh] - (-> fh attrs .lastAccessTime .toMillis (/ 1000) int)) - -(defn octal-mode - [fh] - (apply + (for [x (-> fh .toPath (Files/getPosixFilePermissions (into-array [LinkOption/NOFOLLOW_LINKS])))] - ((keywordize x) java-permission-mode)))) - -(defn permission-set - [fh] - (let [permissions (for [x (-> fh .toPath (Files/getPosixFilePermissions (into-array [LinkOption/NOFOLLOW_LINKS])))] - (clojure.string/lower-case (str x))) - permission-map (for [x ["owner" "group" "others"]] - {(keyword x) (set (map (fn [x] (keyword (second (clojure.string/split x #"_")))) - (filter #(clojure.string/starts-with? % x) permissions)))})] - (into {} permission-map))) - -(defn owner - [fh] - (-> fh attrs .owner .getName)) - -(defn group - [fh] - (-> fh attrs .group .getName)) - -(defn directory? - [fh] - (-> fh attrs .isDirectory)) - -(defn symbolic-link? - [fh] - (-> fh attrs .isSymbolicLink)) - -(defn sizeof - [fh] - (-> fh .length)) - -(defn filename - [fh] - (-> fh .getName)) - -(defn stat-size - [fname uid gid muid] - (+ 2 4 13 4 4 4 8 2 2 2 2 - (sizeof-string fname) - (sizeof-string uid) - (sizeof-string gid) - (sizeof-string muid))) - -(defn file->stat - [file path & {:keys [read-fn parent length] :or {read-fn #'identity parent nil length nil}}] - (let [fh (io/file file) - uid (owner fh) - gid (group fh) - muid uid - fname (if (= file "/") "/" (filename fh)) - mtime (modification-time fh) - ftyp (if (directory? fh) (:qtdir qt-mode) (:qtfile qt-mode)) - size (stat-size fname uid gid muid)] - (map->stat {:qtype ftyp - :qvers (hash mtime) - :qpath path - :permissions (permission-set fh) - :type 0 - :dev 0 - :absolute-path (.getAbsolutePath fh) - :mode (bit-or (octal-mode fh) ftyp) - :atime (access-time fh) - :mtime mtime - :len (if (directory? fh) 0 (or length (sizeof fh))) - :name fname - :uid uid - :gid gid - :muid muid - :ssize (+ size 2) ;; Rstat has a duplicate stat field, so we add this to aid with serialisation - :size size - :children #{} - :parent (if (nil? parent) path parent) - :contents read-fn}))) - -(defn path->stat - [fs path] - (get (:files fs) path)) - -(defn read-dir - [fs stat] - (let [paths (:children stat)] - (for [path paths] - (path->stat fs stat)))) - -(defn root-dir - [path] - (file->stat "/" path :read-fn #'identity)) - -(defn insert-file! - [fs path stat] - (let [files (:files fs)] - (assoc fs :files (assoc files path stat)))) - -(defn update-children! - [fs path child] - (let [stat (path->stat fs path) - children (:children stat) - updated-stat (assoc stat :children (conj children child)) - updated-files (assoc (:files fs) path updated-stat)] - (assoc fs :files updated-files))) - -(defn synthetic-file - [path filename owner group mode contents read-fn len-fn] - (let [size (stat-size filename owner group owner)] - (map->stat {:qtype (:qtfile qt-mode) - :qvers 0 - :qpath path - :permissions {:owner #{:read}, :group #{:read}, :others #{:read}} - :type 0 - :dev 0 - :mode mode - :atime 0 - :mtime 0 - :len len-fn - :custom-data-field contents - :name filename - :uid owner - :gid group - :muid owner - :ssize (+ size 2) ;; Rstat has a duplicate stat field, so we add this to aid with serialisation - :size size - :children #{} - :parent 0 - :contents read-fn}))) - -(defn example-filesystem! - [] - (let [id (keyword (gensym "fs")) - path-pool (atom 0) - root-path @path-pool - file-path (swap! path-pool inc) - another-file-path (swap! path-pool inc) - read-fn (fn [x] (.getBytes (:custom-data-field (:stat x)) "UTF-8")) - example-file (synthetic-file file-path "synthetic-file" "root" "root" 0444 "hello, world!" read-fn (sizeof-string "hello, world!")) - another-example-file (synthetic-file another-file-path "current-time" "root" "root" 0444 "" - (fn [x] (.getBytes (str (quot (System/currentTimeMillis) 1000)) "UTF-8")) - (sizeof-string (str (quot (System/currentTimeMillis) 1000)))) - root-dir (root-dir root-path)] - (-> (map->filesystem {:files {root-path root-dir} :path-pool path-pool :id id :root-path root-path}) - (insert-file! file-path example-file) - (insert-file! another-file-path another-example-file) - (update-children! root-path file-path) - (update-children! root-path another-file-path)))) - -(defn stat-file - [fs path] - (let [f (get (:files fs) path) - stat (into {:frame :stat} f)] - (into {:frame :stat} stat))) - -(defn stat->data - [stat] - ((:contents stat) stat)) - -(defn assoc-fid - [state fid newfid] - (let [mapping (get (:mapping state) fid) - fs-name (:fs-name mapping) - path (:path mapping)] - {:fids (conj (:fids state) newfid) - :mapping (assoc (:mapping state) newfid mapping)})) - -(defn path->name - [fs path] - (:name (get fs path))) - -(defn path->stat - [fs path] - (get (:files fs) path)) - -(defn path->qid - [fs path] - (-> (path->stat fs path) stat->qid)) - -(defn wname->path - [fs path wname] - (if (= wname "..") - (:parent (get (:files fs) path)) - (loop [candidates (:children (get (:files fs) path))] - (let [candidate (first candidates)] - (cond - (nil? candidate) nil - (= (:name (path->stat fs candidate)) wname) candidate - :else (recur (rest candidates))))))) - -(defn walk-path - [fs path wnames] - (loop [candidates wnames - search-path path - paths []] - (let [candidate (first candidates) - candidate-path (wname->path fs search-path candidate)] - (cond - (nil? candidate) paths - (nil? candidate-path) paths - :else (recur (rest candidates) candidate-path (conj paths candidate-path)))))) - -(defn stat->role - [stat user] - (cond - (= user (:uid stat)) :owner - (= user (:gid stat)) :group - :else :other)) - -(defn allowed-op? - [permissions operation] - (let [access-level (operation role-access)] - (clojure.set/subset? access-level permissions))) - -(defn role-resolve - [stat role] - (cond - (= (:uid stat) (:uid role)) :owner - (= (:gid stat) (:gid role)) :group - :else :others)) - -(defn permission-check - [stat rolemap operation] - (let [role (role-resolve stat rolemap) - perms (role (:permissions stat))] - (allowed-op? perms operation))) - -(defn fid->role - [fid conn] - (get (:role conn) (get (:mapping conn) fid))) - -(defn stat-type - [stat] - ((keywordize (:qtype stat)) reverse-qt-mode)) - -(defn fid->mapping - [fid conn] - (get (:mapping conn) fid)) diff --git a/test/phlegyas/frames_test.clj b/test/phlegyas/frames_test.clj index b7d2c9f..c958833 100644 --- a/test/phlegyas/frames_test.clj +++ b/test/phlegyas/frames_test.clj @@ -5,25 +5,28 @@ [phlegyas.types :refer :all] [phlegyas.frames :refer :all])) +(defn test-ns-hook + "Run tests in a sorted order." + [] + (test-vars (->> (ns-interns 'phlegyas.frames-test) vals (sort-by str)))) + +(defn add-test + "Add tests programmatically to the namespace." + [name test-fn] + (intern (ns-name *ns*) (with-meta (symbol name) {:test #(test-fn)}) (fn []))) + (defn read-vector - [v] - (with-open [in (io/input-stream v)] - (let [buf (byte-array (.length v))] + "Read vector from file and produce a byte-array." + [coll] + (with-open [in (io/input-stream coll)] + (let [buf (byte-array (.length coll))] (.read in buf) buf))) -(def vectors (vec (map (fn [x] [(.getName x) (read-vector x)]) (-> "vectors" io/resource .getPath io/file file-seq rest)))) - -(defn add-test - [name ns test-fn & [metadata]] - (intern ns (with-meta (symbol name) (merge metadata {:test #(test-fn)})) (fn []))) +;; fetch vectors +(def vectors (vec (map (fn [vector] [(.getName vector) (read-vector vector)]) (-> "vectors" io/resource .getPath io/file file-seq rest)))) +;; register tests. (dotimes [i (count vectors)] - (let [v (get vectors i)] - (add-test (first v) 'phlegyas.frames-test - #(is (= (vec (second v)) (-> v second disassemble-packet assemble-packet vec)))))) - -(defn test-ns-hook - "Run tests in a sorted order." - [] - (test-vars (->> (ns-interns 'phlegyas.frames-test) vals (sort-by str)))) + (let [[test-name vector] (get vectors i)] + (add-test test-name #(is (= (vec vector) (-> vector disassemble-packet assemble-packet vec))))))