├── doc
└── intro.md
├── .gitignore
├── test
└── clj
│ └── tr069
│ ├── handlers_test.clj
│ ├── test_util.clj
│ ├── core_test.clj
│ ├── schema_test.clj
│ └── session_test.clj
├── src
└── clj
│ └── tr069
│ ├── util.clj
│ ├── session.clj
│ ├── datatype.clj
│ ├── handlers.clj
│ ├── core.clj
│ ├── schema.clj
│ └── databinding.clj
├── README.org
├── resources
├── GetRPCMethods.xml
├── Reboot.xml
├── TransferCompleteResponse.xml
├── InformResponse.xml
├── DeleteObjectResponse.xml
├── AddObject.xml
├── AutonomousTransferCompleteResponse.xml
├── SetParameterValuesResponse.xml
├── DeleteObject.xml
├── AddObjectResponse.xml
├── GetParameterNames.xml
├── DownloadResponse.xml
├── GetParameterValues.xml
├── GetParameterAttributes.xml
├── TransferComplete.xml
├── Download.xml
├── GetParameterNamesResponse.xml
├── GetParameterValuesResponse.xml
├── SetParameterValues.xml
├── SetParameterAttributes.xml
├── AutonomousTransferComplete.xml
├── GetRPCMethodsResponse.xml
├── GetParameterAttributesResponse.xml
├── Fault.xml
└── Inform.xml
└── project.clj
/doc/intro.md:
--------------------------------------------------------------------------------
1 | # Introduction to clj.tr069
2 |
3 | TODO: write [great documentation](http://jacobian.org/writing/great-documentation/what-to-write/)
4 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | /target
2 | /lib
3 | /classes
4 | /checkouts
5 | pom.xml
6 | *.jar
7 | *.class
8 | .lein-deps-sum
9 | .lein-failures
10 | .lein-plugins
11 | temp/*
12 |
--------------------------------------------------------------------------------
/test/clj/tr069/handlers_test.clj:
--------------------------------------------------------------------------------
1 | (ns clj.tr069.handlers-test
2 | (:use clojure.test
3 | clj.tr069.databinding
4 | clj.tr069.schema
5 | clj.tr069.handlers))
6 |
7 |
--------------------------------------------------------------------------------
/test/clj/tr069/test_util.clj:
--------------------------------------------------------------------------------
1 | (ns clj.tr069.test-util)
2 |
3 | (defmacro with-private-fns [[ns fns] & tests]
4 | "Refers private fns from ns and runs tests in context."
5 | `(let ~(reduce #(conj %1 %2 `(ns-resolve '~ns '~%2)) [] fns)
6 | ~@tests))
--------------------------------------------------------------------------------
/src/clj/tr069/util.clj:
--------------------------------------------------------------------------------
1 | (ns clj.tr069.util)
2 |
3 | (def ^:private external-ip-regx
4 | #"^(WANDevice\.\d+\.WANConnectionDevice\.\d+\.WAN[a-zA-Z]+Connection\.\d+\.)ExternalIPAddress$")
5 |
6 | (defn match-external-ip
7 | "Match external IP address parameter in Inform"
8 | [param-name]
9 | (-> (re-seq external-ip-regx param-name)
10 | first
11 | second))
--------------------------------------------------------------------------------
/README.org:
--------------------------------------------------------------------------------
1 | * clj.tr069
2 |
3 | A clojure implementation of the TR-069 ACS
4 |
5 | ** Usage
6 |
7 | Currently it is a work in progress, please come back later for updates, or if you
8 | are interested, you could read the code for what I am doing
9 |
10 | ** License
11 |
12 | Copyright © 2012 Jerry Peng
13 |
14 | Distributed under the Eclipse Public License, the same as Clojure.
15 |
--------------------------------------------------------------------------------
/resources/GetRPCMethods.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
--------------------------------------------------------------------------------
/resources/Reboot.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 | 4321
12 |
13 |
14 |
--------------------------------------------------------------------------------
/resources/TransferCompleteResponse.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
--------------------------------------------------------------------------------
/resources/InformResponse.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 | 3
12 |
13 |
14 |
--------------------------------------------------------------------------------
/resources/DeleteObjectResponse.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 | 2
12 |
13 |
14 |
--------------------------------------------------------------------------------
/resources/AddObject.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 | Barfoo
12 | 11
13 |
14 |
15 |
--------------------------------------------------------------------------------
/resources/AutonomousTransferCompleteResponse.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
--------------------------------------------------------------------------------
/resources/SetParameterValuesResponse.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 | 2
12 |
13 |
14 |
--------------------------------------------------------------------------------
/resources/DeleteObject.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 | Foobar
12 | 1234
13 |
14 |
15 |
--------------------------------------------------------------------------------
/resources/AddObjectResponse.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 | 2
12 | 1
13 |
14 |
15 |
--------------------------------------------------------------------------------
/resources/GetParameterNames.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 | InternetGatewayDevice.DeviceInfo.Hello
12 | false
13 |
14 |
15 |
--------------------------------------------------------------------------------
/project.clj:
--------------------------------------------------------------------------------
1 | (defproject clj.tr069 "0.1.0-SNAPSHOT"
2 | :description "TR-069 ACS"
3 | :url "http://jerrypeng.me"
4 | :license {:name "Eclipse Public License"
5 | :url "http://www.eclipse.org/legal/epl-v10.html"}
6 | :plugins [[lein-ring "0.7.1"]]
7 | :ring {:handler clj.tr069.core/handler
8 | :port 8080}
9 | :dependencies [[org.clojure/clojure "1.4.0"]
10 | [ring/ring-core "1.1.5"]
11 | [org.apache.ws.commons.axiom/axiom-api "1.2.13"]
12 | [org.apache.ws.commons.axiom/axiom-impl "1.2.13"]
13 | ])
14 |
--------------------------------------------------------------------------------
/resources/DownloadResponse.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 | 2
12 | 2012-12-12T12:12:12+08:00
13 | 2012-12-12T13:13:13+08:00
14 |
15 |
16 |
--------------------------------------------------------------------------------
/resources/GetParameterValues.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 |
12 | InternetGatewayDevice.Foo
13 | InternetGatewayDevice.Bar
14 |
15 |
16 |
17 |
--------------------------------------------------------------------------------
/resources/GetParameterAttributes.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 |
12 | InternetGatewayDevice.Foo
13 | InternetGatewayDevice.Bar
14 |
15 |
16 |
17 |
--------------------------------------------------------------------------------
/resources/TransferComplete.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 | 12345
12 |
13 | 9001
14 | Foobar
15 |
16 | 2012-07-13T19:11:11+08:00
17 | 2012-07-13T20:11:11+08:00
18 |
19 |
20 |
--------------------------------------------------------------------------------
/resources/Download.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 | 1234
12 | filetype
13 | url
14 | user1
15 | 654321
16 | 1028
17 | file.bin
18 | 10
19 | succurl
20 | failurl
21 |
22 |
23 |
--------------------------------------------------------------------------------
/resources/GetParameterNamesResponse.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 |
12 |
13 | InternetGatewayDevice.Foo
14 | true
15 |
16 |
17 | InternetGatewayDevice.Bar
18 | false
19 |
20 |
21 |
22 |
23 |
--------------------------------------------------------------------------------
/resources/GetParameterValuesResponse.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 |
12 |
13 | InternetGatewayDevice.Foo
14 | foo
15 |
16 |
17 | InternetGatewayDevice.Bar
18 | 100
19 |
20 |
21 |
22 |
23 |
--------------------------------------------------------------------------------
/resources/SetParameterValues.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 |
12 |
13 | InternetGatewayDevice.Foo
14 | foo
15 |
16 |
17 | InternetGatewayDevice.Bar
18 | 100
19 |
20 |
21 | 1234
22 |
23 |
24 |
--------------------------------------------------------------------------------
/resources/SetParameterAttributes.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 |
12 |
13 | foo
14 | true
15 | 2
16 | true
17 |
18 | Subscriber
19 |
20 |
21 |
22 |
23 |
24 |
--------------------------------------------------------------------------------
/resources/AutonomousTransferComplete.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 | aurl
12 | burl
13 | true
14 | test type
15 | 1028
16 | file.bin
17 |
18 | 9999
19 | test fault
20 |
21 | 2012-07-16T10:10:11+08:00
22 | 2012-07-16T13:10:10+08:00
23 |
24 |
25 |
--------------------------------------------------------------------------------
/resources/GetRPCMethodsResponse.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 | 69b8d731a7c8acbddcf2143497d375e7fdfec585
9 |
10 |
11 |
12 |
13 | AddObject
14 | DeleteObject
15 | GetRPCMethods
16 | GetParameterNames
17 | GetParameterAttributes
18 | GetParameterValues
19 | SetParameterAttributes
20 | SetParameterValues
21 | Download
22 | Upload
23 |
24 |
25 |
26 |
27 |
--------------------------------------------------------------------------------
/resources/GetParameterAttributesResponse.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 |
12 |
13 | Foobar
14 | 1
15 |
16 |
17 |
18 |
19 | YouAndMe
20 | 2
21 |
22 | Subscriber
23 |
24 |
25 |
26 |
27 |
28 |
--------------------------------------------------------------------------------
/resources/Fault.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 |
9 |
10 |
11 | Server
12 | CWMP fault
13 |
14 |
15 | 9005
16 | Parameter not found
17 |
18 | InternetGatewayDevice.DeviceInfo.Foo
19 | 9005
20 | Parameter not found
21 |
22 |
23 | InternetGatewayDevice.DeviceInfo.Bar
24 | 9006
25 | Parameter not writable
26 |
27 |
28 |
29 |
30 |
31 |
--------------------------------------------------------------------------------
/src/clj/tr069/session.clj:
--------------------------------------------------------------------------------
1 | (ns clj.tr069.session
2 | (:use (clj.tr069 schema))
3 | (:import (clj.tr069.schema Inform)))
4 |
5 | (defn new-tr069-session
6 | "Create a new TR-069 session"
7 | [request]
8 | {:state :initializing
9 | :remote-addr (if-let [real-ip (get-in request [:headers "X-Forwarded-For"])]
10 | real-ip
11 | (:remote-addr request))})
12 |
13 | (defn establish
14 | [session inform]
15 | (if (= :initializing (:state session))
16 | (merge session
17 | {:state :established
18 | :device (inform->device inform)
19 | :inform inform})
20 | (throw (IllegalStateException.
21 | "Session state must be :initializing to establish"))))
22 |
23 | (defn start-server-control
24 | [session]
25 | (if (= :established (:state session))
26 | (assoc session :state :server-control)
27 | (throw (IllegalStateException.
28 | "Session state must be :established to start server control"))))
29 |
30 | (defn end-session
31 | [session]
32 | (assoc session :state :ended))
33 |
34 | (defn mark-session-error
35 | [session]
36 | (assoc session :state :error))
37 |
38 | (defn should-close?
39 | [session]
40 | (let [state (:state session)]
41 | (or (= state :ended)
42 | (= state :error))))
--------------------------------------------------------------------------------
/src/clj/tr069/datatype.clj:
--------------------------------------------------------------------------------
1 | (ns clj.tr069.datatype
2 | (:import (javax.xml.bind DatatypeConverter)))
3 |
4 | ; XSD datatype handling
5 | (defmulti parse-value
6 | "Parse an XSD string to a value according to its type"
7 | (fn [type value] (keyword type)))
8 |
9 | (defmethod parse-value nil
10 | [type value]
11 | value)
12 |
13 | (defmethod parse-value :string
14 | [type value]
15 | (DatatypeConverter/parseString value))
16 |
17 | (defmethod parse-value :int
18 | [type value]
19 | (DatatypeConverter/parseInt value))
20 |
21 | (defmethod parse-value :unsignedInt
22 | [type value]
23 | (DatatypeConverter/parseUnsignedInt value))
24 |
25 | (defmethod parse-value :boolean
26 | [type value]
27 | (DatatypeConverter/parseBoolean value))
28 |
29 | (defmethod parse-value :base64
30 | [type value]
31 | (DatatypeConverter/parseBase64Binary value))
32 |
33 | (defmethod parse-value :dateTime
34 | [type value]
35 | (DatatypeConverter/parseDateTime value))
36 |
37 | (defmulti print-value
38 | "Print a value to an XSD string according to its type"
39 | (fn [type value] (keyword type)))
40 |
41 | (defmethod print-value nil
42 | [type value]
43 | (.toString value))
44 |
45 | (defmethod print-value :string
46 | [type value]
47 | (DatatypeConverter/printString value))
48 |
49 | (defmethod print-value :int
50 | [type value]
51 | (DatatypeConverter/printInt value))
52 |
53 | (defmethod print-value :unsignedInt
54 | [type value]
55 | (DatatypeConverter/printUnsignedInt value))
56 |
57 | (defmethod print-value :boolean
58 | [type value]
59 | (DatatypeConverter/printBoolean value))
60 |
61 | (defmethod print-value :base64
62 | [type value]
63 | (DatatypeConverter/printBase64Binary value))
64 |
65 | (defmethod print-value :dateTime
66 | [type value]
67 | (DatatypeConverter/printDateTime value))
68 |
--------------------------------------------------------------------------------
/test/clj/tr069/core_test.clj:
--------------------------------------------------------------------------------
1 | (ns clj.tr069.core-test
2 | (:use clojure.test
3 | clj.tr069.test-util
4 | clj.tr069.core))
5 |
6 | (with-private-fns [clj.tr069.core [wrap-tr069-session]]
7 | (deftest wrap-tr069-session-keep-session
8 | (testing "Session should be present in the response object"
9 | (is (= {:tr-session {:state :established
10 | :remote-addr "202.101.101.101"}}
11 | (let [handler-fn (fn [{s :tr-session}]
12 | {:tr-session
13 | (assoc s
14 | :state
15 | :established)})
16 | handler (wrap-tr069-session handler-fn)
17 | session {:tr-session
18 | {:state :initializing
19 | :remote-addr "202.101.101.101"}}
20 | request {:session session}
21 | response (handler request)]
22 | (:session response))))))
23 |
24 | (deftest wrap-tr069-session-new-session
25 | (testing "New session should be created"
26 | (let [handler (wrap-tr069-session identity)
27 | request {:remote-addr "202.101.101.101"}
28 | response (handler request)]
29 | (is (= {:tr-session {:state :initializing
30 | :remote-addr "202.101.101.101"}}
31 | (:session response))))))
32 |
33 | (deftest wrap-tr069-session-delete-session
34 | (testing "Session should not be present in the response object"
35 | (is (every? nil?
36 | (map (fn [state]
37 | (let [handler-fn #(assoc-in
38 | % [:tr-session :state] state)
39 | handler (wrap-tr069-session handler-fn)
40 | session {:tr-session
41 | {:state :established
42 | :remote-addr "202.101.101.101"}}
43 | request {:session session}
44 | response (handler request)]
45 | (:session response)))
46 | [:ended :error]))))))
--------------------------------------------------------------------------------
/test/clj/tr069/schema_test.clj:
--------------------------------------------------------------------------------
1 | (ns clj.tr069.schema-test
2 | (:use clojure.test
3 | clj.tr069.schema
4 | clj.tr069.databinding)
5 | (:import (clj.tr069.schema Inform
6 | Device
7 | DeviceId
8 | ParameterValueStruct)))
9 |
10 | (def test-inform-object
11 | {:device-id {:oui "09cafe"
12 | :product-class "TEST"
13 | :manufacturer "MOBICLOUD"
14 | :serial-number "0xcafebabe"}
15 | :parameter-list [{:name "InternetGatewayDevice.DeviceSummary"
16 | :value {:type :string :value "test device"}}
17 | {:name "InternetGatewayDevice.DeviceInfo.SpecVersion"
18 | :value {:type :string :value "1.0a"}}
19 | {:name "InternetGatewayDevice.DeviceInfo.HardwareVersion"
20 | :value {:type :string :value "1.0"}}
21 | {:name "InternetGatewayDevice.DeviceInfo.SoftwareVersion"
22 | :value {:type :string :value "1.1"}}
23 | {:name "InternetGatewayDevice.DeviceInfo.ProvisioningCode"
24 | :value {:type :string :value "cloud"}}
25 | {:name "InternetGatewayDevice.ManagementServer.ConnectionRequestURL"
26 | :value {:type :string :value "http://201.101.101.101:1234"}}
27 | {:name "InternetGatewayDevice.ManagementServer.ParameterKey"
28 | :value {:type :string :value "4321"}}
29 | {:name "InternetGatewayDevice.WANDevice.1.WANConnectionDevice.1.WANPPPConnection.1.ExternalIPAddress"
30 | :value {:type :string :value "201.101.101.101"}}]})
31 |
32 | (deftest inform->device-success
33 | (testing "Failure: incorrect device object created from inform"
34 | (is (= (Device.
35 | "09cafe_0xcafebabe"
36 | "09cafe"
37 | "TEST"
38 | "0xcafebabe"
39 | "MOBICLOUD"
40 | "201.101.101.101"
41 | "http://201.101.101.101:1234"
42 | nil
43 | nil
44 | "4321"
45 | "cloud"
46 | "1.0a"
47 | "1.0"
48 | "1.1"
49 | "test device"
50 | "InternetGatewayDevice"
51 | "WANDevice.1.WANConnectionDevice.1.WANPPPConnection.1."
52 | )
53 | (inform->device test-inform-object)))))
--------------------------------------------------------------------------------
/src/clj/tr069/handlers.clj:
--------------------------------------------------------------------------------
1 | (ns clj.tr069.handlers
2 | (:use (clj.tr069 databinding
3 | schema
4 | session))
5 | (:import (clj.tr069.schema Inform
6 | InformResponse
7 | TransferComplete
8 | GetRPCMethods
9 | GetRPCMethodsResponse
10 | AddObject
11 | DeleteObject
12 | GetParameterValues
13 | GetParameterNames
14 | GetParameterAttributes
15 | SetParameterValues
16 | SetParameterAttributes
17 | Download
18 | Upload)))
19 |
20 | (def tr069-msg-type-hierarchy
21 | (-> (make-hierarchy)
22 | (derive ::server-rpc ::rpc-request)
23 | (derive ::cpe-rpc ::rpc-request)
24 | (derive Inform ::server-rpc)
25 | (derive TransferComplete ::server-rpc)
26 | (derive GetRPCMethods ::server-rpc)
27 | (derive GetRPCMethods ::cpe-rpc)
28 | (derive AddObject ::cpe-rpc)
29 | (derive DeleteObject ::cpe-rpc)
30 | (derive GetParameterValues ::cpe-rpc)
31 | (derive GetParameterNames ::cpe-rpc)
32 | (derive GetParameterAttributes ::cpe-rpc)
33 | (derive SetParameterValues ::cpe-rpc)
34 | (derive SetParameterAttributes ::cpe-rpc)
35 | (derive Download ::cpe-rpc)
36 | (derive Upload ::cpe-rpc)))
37 |
38 |
39 | (defmulti handle-tr069-message
40 | (fn [{:keys [tr-message tr-session]}]
41 | (let [state (:state tr-session)]
42 | (if-let [body (:body tr-message)]
43 | [state (type body)]
44 | [state ::empty-msg])))
45 | :default ::invalid-request
46 | :hierarchy #'tr069-msg-type-hierarchy)
47 |
48 | (defmethod handle-tr069-message ::invalid-request
49 | [{:keys [tr-message tr-session]}]
50 | {:tr-session (mark-session-error tr-session)
51 | :tr-message (create-tr069-message
52 | (map->Fault {:fault-code 8003
53 | :fault-string "Invalid argument"}))})
54 |
55 | (defmethod handle-tr069-message [:initializing Inform]
56 | [{:keys [tr-message tr-session]}]
57 | (let [inform (:body tr-message)
58 | tr-session (establish tr-session inform)
59 | inform-resp (InformResponse. (:max-envelopes inform))]
60 | {:tr-message (create-tr069-message inform-resp)
61 | :tr-session tr-session}))
62 |
63 | (defmethod handle-tr069-message [:established ::empty-msg]
64 | [{:keys [tr-session]}]
65 | {:tr-session (start-server-control tr-session)
66 | :tr-message (create-tr069-message (GetRPCMethods.)
67 | :ID (str (System/currentTimeMillis)))})
68 |
69 | (defmethod handle-tr069-message [:server-control GetRPCMethodsResponse]
70 | [{:keys [tr-session]}]
71 | {:tr-session (end-session tr-session)
72 | :tr-message nil})
--------------------------------------------------------------------------------
/src/clj/tr069/core.clj:
--------------------------------------------------------------------------------
1 | (ns clj.tr069.core
2 | (:use (clj.tr069 databinding schema session handlers)
3 | (ring.middleware session))
4 | (:require [clojure.string :as string])
5 | (:import (java.io PushbackInputStream
6 | ByteArrayOutputStream
7 | PrintStream)))
8 |
9 |
10 | (defn- wrap-tr069-method [handler]
11 | (fn [{method :request-method :as request}]
12 | (cond
13 | (= method :post) (handler request)
14 | (= method :get) {:status 200
15 | :headers {"Content-Type" "text/plain"}
16 | :body "ACS is running"}
17 | :else {:status 405})))
18 |
19 | (defn- wrap-tr069-exception [handler]
20 | (fn [request]
21 | (try
22 | (handler request)
23 | (catch Exception e
24 | {:status 400
25 | :headers {"Content-Type" "text/plain"}
26 | :body (let [stream (ByteArrayOutputStream.)
27 | printer (PrintStream. stream)
28 | _ (.printStackTrace e printer)
29 | msg (.toString stream)]
30 | msg)}))))
31 |
32 | (defn- parse-message-or-nil
33 | "Parse TR-069 message, or return nil if the content
34 | is empty"
35 | [body]
36 | (let [in (PushbackInputStream. body)
37 | first-byte (.read in)]
38 | (if (not= -1 first-byte)
39 | (do (.unread in first-byte)
40 | (parse-tr069-message in))
41 | nil)))
42 |
43 | (defn- wrap-tr069-message [handler]
44 | (fn [{body :body :as request}]
45 | (let [req-tr-msg (parse-message-or-nil body)
46 | response (handler (assoc request :tr-message req-tr-msg))
47 | resp-tr-msg (:tr-message response)
48 | response (-> response
49 | (dissoc :tr-message)
50 | (assoc :status 200))]
51 | (if (nil? resp-tr-msg)
52 | (assoc-in response [:headers "Content-Length"] "0")
53 | (let [resp-body (serialize-tr069-message resp-tr-msg)]
54 | (-> response
55 | (assoc-in [:headers "Content-Type"] "text/xml;charset=UTF-8")
56 | (assoc-in [:headers "Content-Length"] (str (.length resp-body)))
57 | (assoc :body resp-body)))))))
58 |
59 | (defn- get-or-create-tr069-session [request]
60 | (if-let [tr-session (:tr-session (:session request))]
61 | tr-session
62 | (new-tr069-session request)))
63 |
64 | (defn- wrap-tr069-session [handler]
65 | (fn [request]
66 | (let [session (get-or-create-tr069-session request)
67 | response (handler (assoc request :tr-session session))
68 | session (:tr-session response)
69 | response (dissoc response :tr-session)]
70 | (if (should-close? session)
71 | (dissoc response :session)
72 | (assoc-in response [:session :tr-session] session)))))
73 |
74 | (defn- cwmp-dispatcher
75 | "Core handler of TR-069 ACS"
76 | [{message :tr-message
77 | session :tr-session
78 | :as request}]
79 | (let [response (handle-tr069-message request)]
80 | (assoc response :status 200)))
81 |
82 | (def handler
83 | (-> cwmp-dispatcher
84 | wrap-tr069-session
85 | wrap-tr069-message
86 | wrap-tr069-exception
87 | wrap-tr069-method
88 | (wrap-session {:cookie-name "tr069-session-id"
89 | :cookie-attrs {:discard true
90 | :version 1}})))
91 |
92 |
--------------------------------------------------------------------------------
/resources/Inform.xml:
--------------------------------------------------------------------------------
1 |
7 |
8 | 69b8d731a7c8acbddcf2143497d375e7fdfec585
9 | 1
10 |
11 |
12 |
13 |
14 | mobi
15 | 999A
16 | test
17 | 0XCAFEBABE
18 |
19 |
20 |
21 | 0 BOOTSTRAP
22 | 12345
23 |
24 |
25 | 1
26 | 2012-07-12T12:00:00+08:00
27 | 0
28 |
29 |
30 | InternetGatewayDevice.WANDevice.1.WANConnectionDevice.1.WANPPPConnection.1.ExternalIPAddress
31 | 202.101.101.101
32 |
33 |
34 | InternetGatewayDevice.ManagementServer.ConnectionRequestURL
35 | http://202.101.101.101:8081
36 |
37 |
38 | InternetGatewayDevice.DeviceSummary
39 | foobar
40 |
41 |
42 | InternetGatewayDevice.ManagementServer.ParameterKey
43 | 123456
44 |
45 |
46 | InternetGatewayDevice.DeviceInfo.ProvisioningCode
47 | 12345
48 |
49 |
50 | InternetGatewayDevice.DeviceInfo.HardwareVersion
51 | 1.0a
52 |
53 |
54 | InternetGatewayDevice.DeviceInfo.SoftwareVersion
55 | 1.1a
56 |
57 |
58 | InternetGatewayDevice.DeviceInfo.SpecVersion
59 | 1.1a
60 |
61 |
62 |
63 |
64 |
65 |
--------------------------------------------------------------------------------
/test/clj/tr069/session_test.clj:
--------------------------------------------------------------------------------
1 | (ns clj.tr069.session-test
2 | (:use clojure.test
3 | clj.tr069.session
4 | clj.tr069.schema
5 | clj.tr069.schema-test)
6 | (:import (clj.tr069.schema Inform
7 | DeviceId
8 | ParameterValueStruct)))
9 |
10 | (deftest new-tr069-session-test-remote-addr
11 | (testing
12 | "Test failure: should use :remote-addr in request map"
13 | (is (=
14 | {:state :initializing
15 | :remote-addr "172.16.0.111"}
16 | (new-tr069-session {:remote-addr "172.16.0.111"})))))
17 |
18 | (deftest new-tr069-session-test-x-forward-for
19 | (testing
20 | "Test failure: should use X-Forwarded-For header to get remote address"
21 | (is (=
22 | {:state :initializing
23 | :remote-addr "202.101.101.101"}
24 | (new-tr069-session {:remote-addr "172.16.0.111"
25 | :headers {"X-Forwarded-For"
26 | "202.101.101.101"}})))))
27 |
28 | (def test-device-object (inform->device test-inform-object))
29 |
30 | (deftest establish-session-success
31 | (testing
32 | "Test failure: session could not be established corretly"
33 | (is (=
34 | {:state :established
35 | :remote-addr "202.101.101.101"
36 | :device test-device-object
37 | :inform test-inform-object}
38 | (establish {:state :initializing
39 | :remote-addr "202.101.101.101"}
40 | test-inform-object)))))
41 |
42 | (deftest establish-session-incorrect-state
43 | (testing
44 | "Test failure: incorrect session state before establishing"
45 | (is (thrown? IllegalStateException
46 | (establish {:state :established
47 | :remote-addr "202.101.101.101"}
48 | test-inform-object)))))
49 |
50 | (deftest start-server-control-success
51 | (testing
52 | "Test failure: error start server control"
53 | (is (=
54 | {:state :server-control
55 | :remote-addr "202.101.101.101"
56 | :device test-device-object
57 | :inform test-inform-object}
58 | (-> {:state :initializing
59 | :remote-addr "202.101.101.101"}
60 | (establish test-inform-object)
61 | start-server-control)))))
62 |
63 | (deftest start-server-control-incorrect-state
64 | (testing
65 | "Test failure: expected exception is not thrown"
66 | (is (thrown? IllegalStateException
67 | (start-server-control
68 | {:state :initializing
69 | :remote-addr "202.101.101.101"})))))
70 |
71 | (deftest end-session-success
72 | (testing
73 | "Test failure: incorrect sessoin state"
74 | (is (= :ended
75 | (-> {:state :initializing
76 | :remote-addr "202.101.101.101"}
77 | end-session
78 | :state)))))
79 |
80 | (deftest mark-session-error-success
81 | (testing
82 | "Test failure: incorrect session state"
83 | (is (= :error
84 | (-> {:state :established
85 | :remote-addr "202.101.101.101"}
86 | mark-session-error
87 | :state)))))
88 |
89 | (deftest ended-session-should-close?
90 | (testing
91 | "Test failure: ened session should be closed!"
92 | (is (should-close?
93 | {:state :ended}))))
94 |
95 | (deftest error-session-should-close?
96 | (testing
97 | "Test failure: session with error should be closed!"
98 | (is (should-close?
99 | {:state :error}))))
--------------------------------------------------------------------------------
/src/clj/tr069/schema.clj:
--------------------------------------------------------------------------------
1 | (ns clj.tr069.schema
2 | (:use (clj.tr069 datatype databinding util))
3 | (:require [clojure.string :as string]))
4 |
5 | ;; Fault struct
6 | (deftr069type FaultStruct
7 | (fault-code :int :FaultCode)
8 | (fault-string :string :FaultString))
9 |
10 | ;; Fault
11 | (deftr069type ^:top-level Fault
12 | (fault-code :int :FaultCode)
13 | (fault-string :string :FaultString)
14 | (details :inline-array :SetParameterValuesFault))
15 |
16 | (deftr069type SetParameterValuesFault
17 | (fault-code :int :FaultCode :int)
18 | (fault-string :string :FaultString))
19 |
20 | ;; Inform
21 | (deftr069type ^:top-level Inform
22 | (device-id :child :DeviceId)
23 | (events :child-array :Event :EventStruct)
24 | (parameter-list :child-array :ParameterList :ParameterValueStruct)
25 | (retry-count :int :RetryCount)
26 | (current-time :dateTime :CurrentTime)
27 | (max-envelopes :int :MaxEnvelopes))
28 |
29 | (deftr069type EventStruct
30 | (command-key :string :CommandKey :string)
31 | (event-code :string :EventCode :string))
32 |
33 | (deftr069type ParameterValueStruct
34 | (name :string :Name :string)
35 | (value :any-simple-value :Value))
36 |
37 | (deftr069type DeviceId
38 | (manufacturer :string :Manufacturer)
39 | (oui :string :OUI)
40 | (product-class :string :ProductClass)
41 | (serial-number :string :SerialNumber))
42 |
43 | ;; Inform Response
44 | (deftr069type ^:top-level InformResponse
45 | (max-envelopes :int :MaxEnvelopes))
46 |
47 | ;; Transfer Complete
48 | (deftr069type ^:top-level TransferComplete
49 | (command-key :string :CommandKey)
50 | (fault :child :FaultStruct)
51 | (start-time :dateTime :StartTime)
52 | (complete-time :dateTime :CompleteTime))
53 |
54 | (deftr069type ^:top-level TransferCompleteResponse)
55 |
56 | ;; Get RPC Methods
57 | (deftr069type ^:top-level GetRPCMethods)
58 |
59 | ;; Get RPC Methods Response
60 | (deftr069type ^:top-level GetRPCMethodsResponse
61 | (method-list :string-array :MethodList))
62 |
63 | ;; Get Parameter Values
64 | (deftr069type ^:top-level GetParameterValues
65 | (parameter-names :string-array :ParameterNames))
66 |
67 | ;; Get Parameter Values Response
68 | (deftr069type ^:top-level GetParameterValuesResponse
69 | (parameter-list :child-array :ParameterList :ParameterValueStruct))
70 |
71 | ;; Get Parameter Names
72 | (deftr069type ^:top-level GetParameterNames
73 | (parameter-path :string :ParameterPath)
74 | (next-level :boolean :NextLevel))
75 |
76 | ;; Get Parameter Names Response
77 | (deftr069type ^:top-level GetParameterNamesResponse
78 | (parameter-list :child-array :ParameterList :ParameterInfoStruct))
79 |
80 | (deftr069type ParameterInfoStruct
81 | (name :string :Name)
82 | (writable :boolean :Writable))
83 |
84 | ;; Get Parameter Attributes
85 | (deftr069type ^:top-level GetParameterAttributes
86 | (parameter-names :string-array :ParameterNames))
87 |
88 | ;; Get Parameter Attributes Response
89 | (deftr069type ^:top-level GetParameterAttributesResponse
90 | (parameter-list :child-array :ParameterAttributeStruct))
91 |
92 | (deftr069type ParameterAttributeStruct
93 | (name :string :Name)
94 | (notification :int :Notification)
95 | (access-list :string-array :AccessList))
96 |
97 | ;; Set Parameter Values
98 | (deftr069type ^:top-level SetParameterValues
99 | (parameter-list :child-array :ParameterValueStruct))
100 |
101 | ;; Set Parameter Values Response
102 | (deftr069type ^:top-level SetParameterValuesResponse
103 | (status :int :Status))
104 |
105 | ;; Set Parameter Attributes
106 | (deftr069type ^:top-level SetParameterAttributes
107 | (parameter-list :child-array :SetParameterAttributesStruct))
108 |
109 | (deftr069type SetParameterAttributesStruct
110 | (name :string :Name)
111 | (notification-change :boolean :NotificationChange)
112 | (notification :int :Notification)
113 | (access-list-change :boolean :AccessListChange)
114 | (access-list :string-array :AccessList))
115 |
116 | ;; Set Parameter Attributes Response
117 | (deftr069type ^:top-level SetParameterAttributesResponse)
118 |
119 | ;; Add Object
120 | (deftr069type ^:top-level AddObject
121 | (object-name :string :ObjectName)
122 | (parameter-key :string :ParameterKey))
123 |
124 | ;; Add Object Response
125 | (deftr069type ^:top-level AddObjectResponse
126 | (instance-number :unsignedInt :InstanceNumber)
127 | (status :int :Status))
128 |
129 | ;; Delete Object
130 | (deftr069type ^:top-level DeleteObject
131 | (object-name :string :ObjectName)
132 | (parameter-key :string :ParameterKey))
133 |
134 | ;; Delete Object Response
135 | (deftr069type ^:top-level DeleteObjectResponse
136 | (status :int :Status))
137 |
138 | ;; Download
139 | (deftr069type ^:top-level Download
140 | (command-key :string :CommandKey)
141 | (file-type :string :FileType)
142 | (url :string :URL)
143 | (username :string :Username)
144 | (password :string :Password)
145 | (file-size :unsignedInt :FileSize)
146 | (target-file-name :string :TargetFileName)
147 | (delay-seconds :unsignedInt :DelaySeconds)
148 | (success-url :string :SuccessURL)
149 | (failure-url :string :FailureURL))
150 |
151 | ;; Download Response
152 | (deftr069type ^:top-level DownloadResponse
153 | (status :int :Status)
154 | (start-time :dateTime :StartTime)
155 | (complete-time :dateTime :CompleteTime))
156 |
157 | ;; Upload
158 | (deftr069type ^:top-level Upload
159 | (command-key :string :CommandKey)
160 | (file-type :string :FileType)
161 | (url :string :URL)
162 | (username :string :Username)
163 | (password :string :Password)
164 | (delay-seconds :unsignedInt :DelaySeconds))
165 |
166 | ;; Upload Response
167 | (deftr069type ^:top-level UploadResponse
168 | (status :int :Status)
169 | (start-time :dateTime :StartTime)
170 | (complete-time :dateTime :CompleteTime))
171 |
172 | ;; Factory Reset
173 | (deftr069type ^:top-level FactoryReset)
174 |
175 | (deftr069type ^:top-level FactoryResetResponse)
176 |
177 |
178 | (defrecord Device
179 | [identifier
180 | oui
181 | product-class
182 | serial-number
183 | manufacturer
184 | ip
185 | ^{:path "ManagementServer.ConnectionRequestURL"} conn-req-url
186 | ^{:path "ManagementServer.ConnectionRequestUsername"} conn-req-username
187 | ^{:path "ManagementServer.ConnectionRequestPassword"} conn-req-password
188 | ^{:path "ManagementServer.ParameterKey"} param-key
189 | ^{:path "DeviceInfo.ProvisioningCode"} provisioning-code
190 | ^{:path "DeviceInfo.SpecVersion"} spec-version
191 | ^{:path "DeviceInfo.HardwareVersion"} hardware-ver
192 | ^{:path "DeviceInfo.SoftwareVersion"} software-ver
193 | ^{:path "DeviceSummary"} device-summary
194 | root-obj-name
195 | wan-path])
196 |
197 | (defn inform->device [inform]
198 | (let [dev-id (:device-id inform)
199 | field-mapping (->> (Device/getBasis)
200 | (map #(if-let [path (:path (meta %))]
201 | [path (keyword %)]))
202 | (remove nil?)
203 | (into {}))
204 | device-map (->> (:parameter-list inform)
205 | (mapcat (fn [{name :name {value :value} :value}]
206 | (let [[root-name path]
207 | (string/split name #"\." 2)]
208 | (if-let [field (field-mapping path)]
209 | {field value
210 | :root-obj-name root-name}
211 | (when-let [ip-path (match-external-ip path)]
212 | {:ip value
213 | :wan-path ip-path})))))
214 | (remove nil?)
215 | (into {:identifier (str
216 | (:oui dev-id) "_"
217 | (:serial-number dev-id))})
218 | (into dev-id))]
219 | (map->Device device-map)))
220 |
--------------------------------------------------------------------------------
/src/clj/tr069/databinding.clj:
--------------------------------------------------------------------------------
1 | (ns clj.tr069.databinding
2 | (:require [clojure.string :as string])
3 | (:use (clj.tr069 datatype))
4 | (:import (org.apache.axiom.soap SOAPEnvelope
5 | SOAPHeaderBlock)
6 | (org.apache.axiom.om OMElement)
7 | (org.apache.axiom.soap.impl.builder StAXSOAPModelBuilder)
8 | (java.io InputStream)
9 | (javax.xml.namespace QName)
10 | (javax.xml.stream XMLInputFactory)))
11 |
12 |
13 | (def ^:private xml-ns-xsd "http://www.w3.org/2001/XMLSchema")
14 | (def ^:private xml-ns-xsi "http://www.w3.org/2001/XMLSchema-instance")
15 | (def ^:private xml-ns-soap "http://schemas.xmlsoap.org/soap/envelope/")
16 | (def ^:private xml-ns-soapenc "http://schemas.xmlsoap.org/soap/encoding/")
17 | (def ^:private xml-ns-cwmp "urn:dslforum-org:cwmp-1-1")
18 |
19 | (def ^:private ^XMLInputFactory xml-input-factory (XMLInputFactory/newFactory))
20 |
21 | (def xsi-type (QName. xml-ns-xsi "type"))
22 |
23 | ; TR-069 Databinding protocol
24 | (defprotocol TR069Databinding
25 | "TR-069 databinding protocol"
26 | (to-slurp [this] "Serialize the object to XML"))
27 |
28 | (extend-protocol TR069Databinding
29 | nil
30 | (to-slurp [this] []))
31 |
32 | (defrecord TypedValue
33 | [type value]
34 | TR069Databinding
35 | (to-slurp [this]
36 | [:Value
37 | (if (nil? type)
38 | {}
39 | {:xsi:type (str "xsd:" type)})
40 | value]))
41 |
42 | ; Parsing methods
43 | (defmulti do-binding
44 | "Do databinding"
45 | (fn [^OMElement om] (keyword (.getLocalName om))))
46 |
47 | ; Helper functions
48 | (defn- xml-string [coll]
49 | (let [elems (partition 3 coll)]
50 | (apply str
51 | (map (fn [[tag attrs body]]
52 | (str "<" (name tag)
53 | (string/join
54 | " " (cons "" (for [[k v] attrs]
55 | (str (name k) "=\"" v "\""))))
56 | ">"
57 | (if (coll? body)
58 | (str "\n" (xml-string body))
59 | (str body))
60 | "" (name tag) ">\n"
61 | ))
62 | elems))))
63 |
64 | (defn parse-type [xsd-type]
65 | (string/replace xsd-type "xsd:" ""))
66 |
67 | (defn array-type [type coll]
68 | {:soapenc:arrayType (str (name type) "[" (count coll) "]")})
69 |
70 | ; Macros for OMElement operations
71 | (defmacro qname [local-name]
72 | `(QName. (name ~local-name)))
73 |
74 | (defmacro first-elem
75 | ([om]
76 | `(.getFirstElement ~om))
77 | ([om local-name]
78 | `(.getFirstChildWithName ~om (qname ~local-name))))
79 |
80 | (defmacro text [om local-name]
81 | `(.getText (.getFirstChildWithName ~om (qname ~local-name))))
82 |
83 | (defmacro child-array-seq [om local-name]
84 | `(iterator-seq
85 | (.getChildElements (.getFirstChildWithName ~om (qname ~local-name)))))
86 |
87 | (defmacro inline-array-seq [om local-name]
88 | `(iterator-seq
89 | (.getChildrenWithLocalName ~om (name ~local-name))))
90 |
91 | (defmacro defbinding [om cls & more]
92 | "Macro for generating do-binding implementation
93 | according to data type schema"
94 | `(new ~cls
95 | ~@(map (fn [[type tag :as form]]
96 | (case type
97 | :child `(do-binding (first-elem ~om ~tag))
98 | :child-array `(map do-binding (child-array-seq ~om ~tag))
99 | :inline-array `(map do-binding (inline-array-seq ~om ~tag))
100 | :string-array `(map #(.getText %) (child-array-seq ~om ~tag))
101 | (:int :unsignedInt :dateTime :base64 :string :boolean)
102 | `(parse-value ~type (text ~om ~tag))
103 | :any-simple-value `(let [child# (.getFirstChildWithName
104 | ~om (qname ~tag))
105 | type# (parse-type
106 | (.getAttributeValue
107 | child# xsi-type))]
108 | (TypedValue.
109 | type#
110 | (parse-value
111 | type#
112 | (.getText child#))))))
113 | more)))
114 |
115 |
116 |
117 | (defmacro deftr069type [cls & more]
118 | "Macro for generating TR-069 datatypes.
119 | The code this macro generates contains a defrecord and a defmethod,
120 | the defrecord form generates a record class for the type, and the
121 | defmethod form implements do-databinding"
122 | (let [is-top-level (:top-level (meta cls))
123 | cls-name (name cls)
124 | root-tag-name (if is-top-level (str "cwmp:" cls-name) cls-name)]
125 | `(do
126 | (defrecord ~cls
127 | [~@(map first more)]
128 | TR069Databinding
129 | (to-slurp [this]
130 | [~(keyword root-tag-name) {}
131 | (concat
132 | ~@(map (fn [[field type tag :as form]]
133 | (case type
134 | :child `(to-slurp ~field)
135 | :child-array `[~tag
136 | (array-type
137 | (keyword
138 | (str "cwmp:" ~(name (last form))))
139 | ~field)
140 | (mapcat to-slurp ~field)]
141 | :string-array `[~tag
142 | (array-type :xsd:string ~field)
143 | (mapcat #(vector :string {} %) ~field)]
144 | :inline-array `(mapcat to-slurp ~field)
145 | (:int :unsignedInt :dateTime :base64 :string :boolean)
146 | `[~tag {} (print-value ~type ~field)]
147 | :any-simple-value `(to-slurp ~field))
148 | )
149 | more)
150 | )
151 | ]))
152 | (defmethod do-binding ~(keyword cls)
153 | [^OMElement om#]
154 | (defbinding om# ~cls ~@(map rest more))))))
155 |
156 |
157 | ; Functions for parsing SOAP envelope
158 |
159 | (defn- parse-envelope
160 | [^InputStream in]
161 | (let [builder (StAXSOAPModelBuilder.
162 | (.createXMLStreamReader xml-input-factory in))]
163 | (.getSOAPEnvelope builder)))
164 |
165 | (defn- get-body
166 | [^SOAPEnvelope envelope]
167 | (let [body (.getBody envelope)
168 | fault (.getFault body)]
169 | (if (.hasFault envelope)
170 | {:fault {:fault-code (.getText (.getCode fault))
171 | :detail (do-binding (first-elem (.getDetail fault)))}}
172 | (do-binding (.getFirstElement body)))))
173 |
174 | (defn- get-header
175 | [^SOAPEnvelope envelope]
176 | (let [header (.getHeader envelope)]
177 | (reduce (fn [hdr-map ^SOAPHeaderBlock hdr-blk]
178 | (assoc hdr-map (keyword (.getLocalName hdr-blk))
179 | {:must-understand (.getMustUnderstand hdr-blk)
180 | :name (.getLocalName hdr-blk)
181 | :value (.getText hdr-blk)}))
182 | {}
183 | (iterator-seq (.extractAllHeaderBlocks header)))))
184 |
185 | (defn parse-tr069-message
186 | "Parse a SOAP envelope to a TR-069 message map"
187 | [^InputStream in]
188 | (let [envelope (parse-envelope in)]
189 | {:header (get-header envelope)
190 | :body (get-body envelope)}))
191 |
192 | (defn serialize-tr069-message
193 | "Serialize a TR-069 message map to a SOAP envelope XML"
194 | [{:keys [header body]}]
195 | (xml-string
196 | [:soap:Envelope {:xmlns:xsd xml-ns-xsd
197 | :xmlns:xsi xml-ns-xsi
198 | :xmlns:soap xml-ns-soap
199 | :xmlns:soapenc xml-ns-soapenc
200 | :xmlns:cwmp xml-ns-cwmp
201 | }
202 | [:soap:Header {} (mapcat (fn [[hdr-name {:keys [must-understand value]}]]
203 | [(str "cwmp:" (name hdr-name))
204 | {:soap:mustUnderstand (if must-understand 1 0)}
205 | value])
206 | header)
207 | :soap:Body {} (if-let [{:keys [fault-code fault-string detail]}
208 | (:fault body)]
209 | [:Fault {}
210 | [:faultcode {} fault-code
211 | :faultstring {} "CWMP fault"
212 | :detail {} (to-slurp detail)]]
213 | (to-slurp body))] ]))
214 |
215 | (defn create-tr069-message
216 | "Create a TR-069 message programatically."
217 | [body & {:as headers}]
218 | {:header (reduce (fn [hdrs [k v]]
219 | (assoc hdrs k {:name k
220 | :must-understand true
221 | :value v}))
222 | {}
223 | headers)
224 | :body body})
225 |
--------------------------------------------------------------------------------