Coverage report: /development/source/library/org/datagraph/spocq-shard/src/spocq-server/configuration.lisp

Kind	Covered	All	%
expression	44	210	21.0
branch	0	22	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.server.implementation; -*-

2

3

(in-package :org.datagraph.spocq.server.implementation)

4

5

(:documentation "http configuration"

6

"The HTTP configuration is managed similar to that for a query processor which is executed

7

as a command. In addition to initialization settings, each request establishes a dynamic

8

context for global configuration variables and extends it with the http request configuration.

9

This involves applying parse-http-configuration to the collected header and query arguments,

10

as returned by request-configuration-list. The parse step extracts those arguments which

11

are http settings in *http-argument-to-setting-map*, canonicalizing the argument name and

12

then the values.")

13

14

(defparameter *http-argument-to-setting-map* (make-hash-table :test 'equalp)

15

"A hash table to translate between http run-time setting keywords.

16

It includes both header and query parameter names, but just those which are to be captured

17

as dynamic bindings.

18

Any parameters to be retrieved locally, as required, are left in the request or response object.

19

Some are ignored.

20

- remote-ip-address : local

21

- acceptCharset : utf-8 should be established as an explicit default, but is not

22

- acceptEncoding : local

23

- ifRange : not supported

24

- Range : first-last or limit x offset y

25

- auth_token : local to the authentication functions

26

- IfModifiedSince/IfUnmodifiedSince: local to theNotModified response logic

27

- $.* -> bindings : processed locally in execute-graph-store-query

28

alpha->settings

29

! needs to go into an around function in graph-store-response :

30

! request->link_jsonld_context() -> settings['context']

31

xsl-stylesheet needs to be post-processed

32

- agent-id came from the dydra-query front-end an is not present from http directly

33

- timeout = set global parameter

34

- settings : came from the dydra-uery front-end

35

36

.")

37

38

(loop for (setting-name . argument-names)

39

in '((:accept-date-time "acceptDateTime")

40

(:agent-id "agentId")

41

(:agent-location "agentLocation")

42

(:api-key "apiKey")

43

(:base-iri "base" "baseIRI")

44

(:blank-node-prefix "skolemizePrefix")

45

(:blank-node-skolemize "skolemize")

46

(:default-context-term "defaultContextTerm")

47

(:default-graphs "defaultGraphs" "from" "defaultGraphURI")

48

(:describe-form "describeForm")

49

(:describe-object-depth "describeObjectDepth")

50

(:describe-subject-depth "describeSubjectDepth")

51

(:dynamic-bindings "dynamicBindings")

52

(:federation-mode "federationMode")

53

(:end-time "endTime")

54

(:import-limit "importLimit")

55

(:link "link") ; recognize link headers

56

(:memory-limit "memoryLimit")

57

(:named-contexts-term "namedContextsTerm")

58

(:named-graphs "namedGraphs" "fromNamed" "namedGraphURI")

59

(:namespace-bindings "prefixes" "namespaceBindings")

60

(:operation-limit "operationLimit")

61

(:provenance-repository-id "provenanceRepositoryID" "provenanceRepository")

62

(:query-signature "signature" "querySignature")

63

(:range "range")

64

(:repository-id "repositoryID" "repository")

65

(:request-content-type "contentType" "queryContentType" "requestContentType")

66

(:request-values "values" "valuesData")

67

(:response-charset "acceptCharset")

68

(:response-content-type "accept" "responseContentType")

69

(:response-encoding "acceptEncoding")

70

(:response-limit "limit" "responseLimit" "queryLimit")

71

(:response-offset "offset" "responseOffset" "queryOffset")

72

(:revision-end-time "revisionEndTime")

73

(:revision-id "revisionUUID" "revisionID" "revision")

74

(:revision-start-time "revisionStartTime")

75

(:library-path "libraryPath" "librarypath" "library-path" )

76

(:start-time "startTime")

77

(:task-id "Request-ID" "queryID" "id" "taskID")

78

(:time-interval "timeInterval")

79

(:time-limit "timeLimit")

80

(:trace-routing-key "traceRoutingKey")

81

(:undefined-variable-behavior "undefinedVariableBehavior")

82

(:user-id "userID" "userTag" "clientRequestID")

83

(:xslt-stylesheet "xslt" "xsltstylesheet"))

84

do (loop for argument-name in argument-names

85

do (setf (gethash argument-name *http-argument-to-setting-map*) setting-name)))

86

87

(defun http-argument-setting (argument-name)

88

(gethash argument-name *http-argument-to-setting-map*))

89

90

#|

91

20170520: reconcile with php

92

the php chain is nginx->php(dydra-query)->shell(dydra-query)->sharedmem->store->spocq

93

of which the nginx,dydra-query. ans spoc interfaces each has its representation for the options

94

this implements the direct acquisition from the http headers

95

- /opt/rails/public/cgi-bin/sparql.php

96

- /development/source/library/com/unfuddle/dydra/dydra-ndk/src/query/query.cc

97

sparql.php:

98

99

|#

100

(defun parse-http-configuration (configuration-association-list &optional (argument-list ()))

101

"Given an http a-list with the query and/or form arguments, assemble a property

102

list in which the keys are the canonical settings' names and then canonicalize this to

103

produce a request configuration p-list with converted assembled compound argument values.

104

105

The process involves a case-insensitive comparison with a key value which is net all

106

non-alphanumeroc characters."

107

108

(loop for (argument-name . value) in configuration-association-list

109

for canonical-argument-name = (remove-if-not #'alpha-char-p (string argument-name))

110

for setting-name = (http-argument-setting canonical-argument-name)

111

when setting-name

112

do (case setting-name

113

((:values :values-data :request-values)

114

(push value (getf argument-list :request-values)))

115

(t

116

(setf argument-list (list* setting-name value argument-list)))))

117

(dydra:canonicalize-argument-list argument-list))

118

119

(defmethod dydra:canonicalize-configuration-argument ((key (eql :link)) (value string))

120

"Deconstruct the rfc5988 link to extract the target, ref and type

121

determine the effective argument name, transform the value, return the new list.

122

(see https://tools.ietf.org/rfc/rfc5988.txt)

123

This parses all headers, but returns just the first one.

124

multiple headers are not permitted"

125

(let* ((parsed-values (parse-http-link-header value))

126

(parsed-value (first parsed-values)))

127

(when (rest parsed-values)

128

(error 'multiple-context-link-headers))

129

(destructuring-bind (target &rest arguments &key rel &allow-other-keys) parsed-value

130

(when (and target rel)

131

(apply #'canonicalize-link-argument target (cons-symbol :keyword rel) arguments)))))

132

133

(defun parse-http-link-header (header)

134

135

(let ((link-phrases (split-string header ","))

136

(target-scanner (load-time-value

137

                          (cl-ppcre:create-scanner `(:sequence (:greedy-repetition 0 nil :whitespace-char-class)

138

#\<

139

                                                               (:register (:sequence (:greedy-repetition 0 nil (:inverted-char-class #\>))))

140

                                                               #\>))))

141

(argument-scanner (load-time-value

142

(cl-ppcre:create-scanner `(:sequence

143

                                                       (:greedy-repetition 0 nil :whitespace-char-class)

144

#\;

145

                                                       (:greedy-repetition 0 nil :whitespace-char-class)

146

                                                       (:register (:greedy-repetition 1 nil (:inverted-char-class #\= :whitespace-char-class)))

147

                                                       (:greedy-repetition 0 nil :whitespace-char-class)

148

#\=

149

                                                       (:greedy-repetition 0 nil :whitespace-char-class)

150

#\"

151

                                                       (:register (:greedy-repetition 1 nil (:inverted-char-class #\")))

152

#\")))))

153

(loop for phrase in link-phrases

154

collect

155

(multiple-value-bind (matched target)

156

(cl-ppcre:scan-to-strings target-scanner header)

157

(when matched (let* ((start (length matched))

158

                              (arguments (loop for (matched binding) = (multiple-value-list (cl-ppcre:scan-to-strings argument-scanner header :start start))

159

until (null matched)

160

                                           append (list (cons-symbol :keyword (aref binding 0)) (aref binding 1))

161

                                           do (incf start (length matched)))))

162

(cons (aref target 0)

163

arguments)))))))

164

165

 ;;; (parse-http-link-header "<http://json-ld.org/contexts/person>; rel=\"describedby\"; type=\"application/ld+json\"")

166

167

168

169

(defgeneric canonicalize-link-argument (target relation &rest args)

170

;; allow old and new

171

(:method ((target t) (relation t) &rest args)

172

(log-warn "unknown link relation: ~s ~s . ~s" target relation args)

173

nil)

174

(:method ((target string) (relation (eql :describedby)) &key type &allow-other-keys)

175

(when (equal type "application/ld+json")

176

(list :context target)))

177

   (:method ((target string) (relation (eql :|HTTP://WWW.W3.ORG/NS/JSON-LD#CONTEXT|)) &key type &allow-other-keys)

178

(when (equal type "application/ld+json")

179

(list :context target))))

180

181

182

183

(defmethod dydra:canonicalize-configuration-argument ((key (eql :range)) (value string))

184

"Deconstruct the rfc7233 range either as

185

first-last

186

or as

187

limit <limit> offset <offset>

188

and normalize to expressit as a slice.

189

(see https://tools.ietf.org/html/rfc7233)"

190

(when (spocq.e:string-starts value "solutions=")

191

(setf value (subseq value 10))

192

(destructuring-bind (first &optional last) (split-string value "-")

193

(if last

194

(let ((first (parse-integer first))

195

(last (parse-integer last)))

196

`(:offset ,first :limit ,(1+ (- last first))))

197

(dydra:parse-term value :production 'sparql-1-0-4::|LimitOffsetClauses|)))))

198

199

200

201

(defgeneric call-with-http-configuration-bound (op &rest args)

202

(:method (op &rest dydra:*request-headers*

203

&key

204

((:operation dydra:*operation*) dydra:*operation*)

205

((:context json-ld:*context*) json-ld:*context*)

206

&allow-other-keys)

207

(declare (dynamic-extent dydra:*request-headers*))

208

;; (print (list :headers dydra:*request-headers*))

209

(apply #'dydra:call-with-configuration-bound op dydra:*request-headers*)))

210

211

212

(defmacro with-http-configuration (parsed-argument-list &body body)

213

(let ((op (gensym "with-http-configuration")))

214

`(flet ((,op () ,@body))

215

(declare (dynamic-extent #',op))

216

;; (print (list :parsed ,parsed-argument-list))

217

(apply #'call-with-http-configuration-bound #',op ,parsed-argument-list))))

218

219

220

221

(defmethod (setf spocq.i:configuration-parameter) ((value list) (parameter (eql :response-functions)))

222

(assert (every #'(lambda (name)

223

                      (cond ((and (symbolp name) (fboundp name) (typep (symbol-function name) 'http:resource-function)))

224

(t

225

(warn "Invalid response function name: ~s." name))))

226

value)

227

()

228

"All response functions must be resource functions.")

229

(setq *response-functions* value))

230

231

(defmethod (setf spocq.i:configuration-parameter) ((value string) (parameter (eql :accept-date-time)))

232

(setq spocq.i::*revision-id* value))

233

234

(defmethod (setf spocq.i:configuration-parameter) ((value string) (parameter (eql :enable-content-encoding)))

235

(setq *graph-store-get.enable-content-encoding* (if value t nil)))

236

237

(defmethod (setf spocq.i:configuration-parameter) ((value string) (parameter (eql :history-directory)))

238

(setf (spocq.i:configuration-parameter :history-directory) (pathname value)))

239

240

(defmethod (setf spocq.i:configuration-parameter) ((value null) (parameter (eql :history-directory)))

241

(setq *history-directory* nil))

242

243

(defmethod (setf spocq.i:configuration-parameter) ((value pathname) (parameter (eql :history-directory)))

244

(assert (probe-file value) () "Invalid history-directory: ~s." value)

245

(setq *history-directory* value))

246

247

(defmethod (setf spocq.i:configuration-parameter) ((value integer) (parameter (eql :host-port)))

248

(setq *host-port* value))

249

250

(defmethod (setf spocq.i:configuration-parameter) ((value integer) (parameter (eql :http-accept-count-limit)))

251

(setq *http-accept-count-limit* value))

252

253

(defmethod (setf spocq.i:configuration-parameter) ((value symbol) (parameter (eql :http-log-level)))

254

(assert (member value http:*log-levels*) ()

255

"Invalid log-level: ~s." value)

256

(setq http:*log-level* value))

257

258

(defmethod (setf spocq.i:configuration-parameter) ((value t) (parameter (eql :memento-response-headers)))

259

(setq *memento-response-headers* (not (null value))))

260

261

(defmethod (setf spocq.i:configuration-parameter) ((value null) (parameter (eql :request-count-limit)))

262

(setq *request-count-limit* value))

263

264

(defmethod (setf spocq.i:configuration-parameter) ((value integer) (parameter (eql :request-count-limit)))

265

(setq *request-count-limit* value))

266

267

(defmethod (setf spocq.i:configuration-parameter) ((value t) (parameter (eql :supersede-post-quad-graphs)))

268

(setq *supersede-post-quad-graphs* (not (null value))))

269

270

(defmethod (setf spocq.i:configuration-parameter) ((value t) (parameter (eql :transport-security-mode)))

271

(assert (member value '(nil :strict)) ()

272

"Invalid transport security mode: ~s" value)

273

(setq *transport-security-mode* value))

274

275

(defmethod (setf spocq.i:configuration-parameter) ((value symbol) (parameter (eql :taskmaster-class)))

276

(assert (subtypep value 'spocq-taskmaster) ()

277

"Invalid taskmaster class: ~s" value)

278

(setq *class.taskmaster* value))

279

280

281

282

;;; atandard request argument access

283

284

(defun request-client-request-id (request)

285

(or (http:request-header request :client-request-id)

286

(http:request-query-argument request "USER-ID")

287

(http:request-query-argument request "user_id")))