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

Kind	Covered	All	%
expression	474	1231	38.5
branch	25	70	35.7

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

6

7

 (defgeneric repository-patch-graph-content (repository source &key client-request-id content-type context content-encoding task-id)

8

(:documentation "Import the given content into the designated repository into the designated graph.

9

The source is intended to be a temporary file which caches the request content.

10

     :content-type is either that specified as the request content or the result of a local transformation.

11

:context is a graph uri.")

12

13

(:method ((repository-id string) source &rest args)

14

(declare (dynamic-extent args))

15

(apply #'repository-patch-graph-content (dydra:repository repository-id) source args))

16

17

(:method ((repository dydra:repository) source &rest args)

18

(declare (dynamic-extent args))

19

(unless (dydra:repository-exists-p repository)

20

(http:not-found "Repository not found: ~s." (dydra:repository-id repository)))

21

(apply #'repository-import-graph-content repository source :method "PATCH" args)))

22

23

(defgeneric repository-patch-multipart-content (repository source &key

24

                                                 task-id client-request-id

25

context

26

                                                 content-type content-encoding)

27

   (:documentation "Import the given content into the designated repository as per the part specifications.

28

The source is intended to be a temporary file which caches the request content.

29

no content-type is as per the respective part header.

30

:context is a graph uri.")

31

32

(:method ((repository-id string) (source t) &rest args)

33

(declare (dynamic-extent args))

34

(apply #'repository-patch-multipart-content (dydra:repository repository-id) source args))

35

36

(:method ((repository t) (source pathname) &rest args &key

37

(content-encoding nil)

38

&allow-other-keys)

39

(declare (dynamic-extent args))

40

;; nb. (graph-store-response :decode) has done it

41

(case (typecase content-encoding

42

(symbol content-encoding)

43

(string (find-symbol (string-upcase content-encoding) :keyword))

44

(t (http:unsupported-media-type "Unsupported content encoding: ~a" content-encoding)))

45

((nil)

46

(with-open-file (stream source :direction :input :element-type :default)

47

(apply #'repository-patch-multipart-content repository stream args)))

48

       (:gzip (let ((decompressed-pathname (tmp-import-pathname (dydra:account (dydra:repository-account repository))

49

                                                                  (dydra:repository repository))))

50

                  (prog1 (with-open-file (input source :direction :input :element-type '(unsigned-byte 8))

51

                           (with-open-file (output decompressed-pathname :direction :output

52

                                                   :element-type '(unsigned-byte 8)

53

                                                   :if-does-not-exist :create)

54

                             (let ((process (unwind-protect (run-program "/bin/gunzip" ;; dydra:*executable-pathname.zip*

55

                                                                         `("-c" ,(namestring (truename source)))

56

                                                                         :input input :output output

57

                                                                         :environment ()  ;; isolate rapper from dydra libraries

58

                                                                         :wait t)

59

                                              (conditional-delete-file source))))

60

(when process

61

                                 (unwind-protect (when (zerop (run-program-exit-code process))

62

                                                   (with-open-file (stream decompressed-pathname :direction :input :element-type :default)

63

                                                     (apply #'repository-patch-multipart-content repository stream args)))

64

(run-program-close process))))))

65

(conditional-delete-file decompressed-pathname))))

66

(t (http:unsupported-media-type "Unsupported content encoding: ~a" content-encoding))))

67

68

(:method ((repository dydra:repository) (input-stream stream) &key

69

;; revision-id ;; NYI : for branching

70

content-type context method

71

content-encoding

72

(request http:*request*)

73

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

74

(task-id nil))

75

(declare (ignore content-encoding))

76

;; extract a default type and the separator from the content type

77

(let* ((boundary (mime:mime-type-boundary content-type))

78

(separator (concatenate 'string "--" boundary)) ; https://tools.ietf.org/html/rfc2046

79

(original-content-type (mime:mime-type (or (mime:mime-type-content-type content-type)

80

                                                       mime:application/n-quads)))

81

(original-graph-name context)

82

(repository-id (dydra:repository-id repository))

83

(base-revision-id (or (http:request-header request "If-Match")

84

                                  (http:request-query-argument request "revision-id")

85

(http:request-header request "Revision")))

86

(new-revision-id (dydra:make-revision-id))

87

(line-number 0)

88

(statement-count 0)

89

(deleted-count 0)

90

(inserted-count 0)

91

(transaction-uuid nil))

92

(unless (dydra:repository-exists-p repository)

93

(http:not-found "Repository not found: ~s." repository-id))

94

(when (find repository-id spocq.i::*disabled-repositories* :test #'string-equal)

95

(http:bad-request "The repository has been disabled: ~s." repository-id))

96

;; Generate a new transaction id and check that, if an explicit base revision

97

;; was supplied, that it matches the current head.

98

       (dydra:with-open-transaction (repository-id :id new-revision-id :revision-id "HEAD" :normal-disposition :commit

99

:serialize t)

100

(when base-revision-id

101

(unless (equalp base-revision-id (spocq.i::transaction-parent-revision-id *transaction*))

102

(http:precondition-failed "The repository has been modified: ~s: ~s != ~s"

103

repository-id

104

                                       (spocq.i::transaction-parent-revision-id *transaction*)

105

base-revision-id)))

106

(let* ((operation :post)

107

(graph-name original-graph-name)

108

(content-type original-content-type)

109

(statements ()))

110

(labels ((read-next-line ()

111

(when (peek-char t input-stream nil)

112

(incf line-number)

113

(read-line input-stream)))

114

(read-part-header ()

115

(setf graph-name original-graph-name)

116

(let* ((CHUNGA:*ACCEPT-BOGUS-EOLS* t)

117

(headers (tbnl::read-http-headers input-stream)))

118

(loop for (keyword . value) in headers

119

do (incf line-number)

120

do (case keyword

121

;; content type alternatives NYI

122

                               (:content-type (setf content-type (mime:mime-type value))

123

                                              (unless (typep content-type original-content-type)

124

;; others nyi

125

                                                (error "invalid content-type[~d]: ~s" line-number value)))

126

(:x-http-method-override (setf operation

127

                                                              (or (find value '(:delete :post :put) :test #'string-equal)

128

                                                                  (http:bad-request "invalid patch method: ~s." value))))

129

(:graph (setf graph-name (dydra:intern-iri value)))

130

(t ))))

131

;; count blank line

132

(incf line-number))

133

(process-parts ()

134

(loop for line = (read-next-line)

135

until (null line)

136

do (cond ((zerop (length line))) ; skip

137

                                 ((string= separator line :end2 (min (length separator) (length line)))

138

                                  (setf line (string-trim #(#\space #\tab #\return #\linefeed) line))

139

(when statements

140

(perform-operation operation statements)

141

(setf statements ()))

142

                                  (when (and (>= (length line) (length separator))

143

                                             (string= "--" line :start2 (- (length line) 2)))

144

(return))

145

(read-part-header))

146

(t

147

                                  (let ((statement (dydra:parse-nquads-statement line)))

148

(unless statement

149

                                      (http:bad-request "invalid statement[~d]: ~s" line-number line))

150

(incf statement-count)

151

(push (cond ((cdddr statement)

152

                                                 (cons 'spocq.a:|quad| statement))

153

(graph-name

154

                                                 (cons 'spocq.a:|quad| (append statement (list graph-name))))

155

(t

156

                                                 (cons 'spocq.a:|triple| statement)))

157

statements))))))

158

(perform-operation (operation statements)

159

(ecase operation

160

(:delete

161

;; delete given statements

162

(spocq.i::repository-delete-field repository statements)

163

(incf deleted-count (length statements)))

164

(:post

165

;; insert given statements

166

(spocq.i::repository-insert-field repository statements)

167

(incf inserted-count (length statements)))

168

(:put

169

;; delete the current graph, then post

170

                         (spocq.i::repository-clear-graph repository (or graph-name :default) :if-does-not-exist nil)

171

(spocq.i::repository-insert-field repository statements)

172

(incf inserted-count (length statements))))))

173

(process-parts)))

174

(setf transaction-uuid (spocq.i::transaction-id *transaction*)))

175

;; upon completion, return transaction record

176

;; do not write a transaction event - that happens as part of the transaction-close(commit)

177

(let ((rr

178

(if (spocq.i::repository-is-revisioned repository)

179

(let* ((rlr (rlmdb:get-revision-log-record repository transaction-uuid)))

180

(cond (rlr

181

                           ;; change to correspond to import document rather than repository changes

182

                           (setf (rlmdb:revision-log-record-removed-count rlr) deleted-count)

183

                           (setf (rlmdb:revision-log-record-inserted-count rlr) inserted-count)

184

rlr)

185

(t

186

                           (log-warn "repository-patch-multipart-content: no revision log record: ~s ~s" repository transaction-uuid)

187

nil)))

188

(let* ((mr (rlmdb:get-metadata-record repository)))

189

(cond (mr

190

mr)

191

(t

192

                           (log-warn "repository-patch-multipart-content: no metadata record: ~s" repository)

193

nil))))))

194

(log-notice "service ~s: ~s ~s '~s'. complete: ~s"

195

                     task-id method repository-id (or client-request-id "-") (or rr transaction-uuid))

196

(values rr deleted-count inserted-count)))))

197

198

 (defgeneric repository-post-graph-content (repository source &key client-request-id content-type context content-encoding task-id)

199

(:documentation "Import the given content into the designated repository into the designated graph.

200

The source is intended to be a temporary file which caches the request content.

201

     :content-type is either that specified as the request content or the result of a local transformation.

202

:context is a graph uri.")

203

204

(:method ((repository-id string) source &rest args)

205

(declare (dynamic-extent args))

206

(apply #'repository-post-graph-content (dydra:repository repository-id) source args))

207

208

(:method ((repository dydra:repository) source &rest args)

209

(declare (dynamic-extent args))

210

(unless (dydra:repository-exists-p repository)

211

(http:not-found "Repository not found: ~s." (dydra:repository-id repository)))

212

(apply #'repository-import-graph-content repository source :method "POST" args)))

213

214

 (defgeneric repository-put-graph-content (repository source &key client-request-id content-type context content-encoding task-id)

215

216

(:method ((repository-id string) source &rest args)

217

(declare (dynamic-extent args))

218

(apply #'repository-put-graph-content (dydra:repository repository-id) source args))

219

220

(:method (repository source &rest args)

221

(declare (dynamic-extent args))

222

(unless (dydra:repository-exists-p repository)

223

(http:not-found "Repository not found: ~s." (dydra:repository-id repository)))

224

;; at this point, once the data is staged, clear for a put request

225

(dydra:log-debug "clear repository for :put: ~a" (dydra:repository-id repository))

226

;; leave the clearing to the put operation

227

(apply #'repository-import-graph-content repository source :method "PUT" args)))

228

229

(:documentation "asynchronous import"

230

                 "The response operations for patch/post/put recognize headers for asynchronous operation.

231

  When those headers are present, the handler writes an entry into a queue directory to carry the necessary

232

  request/response headers over from the request, includes the temporary file location and leaves this to

233

be processed by a background process.

234

  That process runs in one of the servers, picks up each entry in turn, completes the import, constucts a

235

log entry which it dispatches to the notification location.

236

237

the log entries encodes the state as a single solution of the variables. the nxp notification

238

239

?state ?clientId ?etag ?message")

240

241

(defgeneric repository-queue-graph-import (request repository pathname &key

242

task-id

243

                                             context content-type content-encoding

244

                                             notify-location notify-content-type

245

accept

246

notify-method

247

client-request-id)

248

(:documentation "given a repository and import content, create an asynchronous import task.

249

This includes a request id, which is returned as the result")

250

(:method (request (repository repository) (pathname pathname) &key

251

(task-id (dydra:make-task-id))

252

context content-type notify-location (notify-content-type mime:application/json)

253

(accept notify-content-type)

254

notify-method

255

client-request-id

256

content-encoding)

257

(let* ((asynchronous-headers `(("Content-Type" . ,(mime:mime-type-namestring content-type))

258

,@(when accept `(("Accept" . ,accept)))

259

                                    ,@(when content-encoding `(("Content-Encoding" . ,content-encoding)))

260

                                    ("Authorization" . ,(http:request-header request :authorization))

261

                                    ("Asynchronous-Authorization" . ,(http:request-header request "Asynchronous-Authorization"))

262

("Asynchronous-Location" . ,notify-location)

263

                                    ("Asynchronous-Content-Type" . ,(when notify-content-type

264

                                                                      (mime:mime-type-namestring notify-content-type)))

265

                                    ("Asynchronous-Method" . ,(or notify-method :post))

266

("Request-ID" . ,task-id)

267

("Client-Request-ID" . ,client-request-id)))

268

(temp-pathname (make-pathname :name (concatenate 'string "-" task-id)

269

                                          :defaults (spocq.i::import-queue-root-pathname)))

270

            (queue-entry-pathname (make-pathname :name task-id :defaults (spocq.i::import-queue-root-pathname))))

271

(ensure-directories-exist queue-entry-pathname)

272

       (with-open-file (queue-entry-stream temp-pathname :direction :output :if-exists :error :if-does-not-exist :create)

273

(write-import-queue-headers queue-entry-stream request repository asynchronous-headers context))

274

(alexandria:copy-file pathname temp-pathname :if-to-exists :append)

275

(rename-file temp-pathname queue-entry-pathname)

276

(dydra:log-notice "asynchronous request queued: ~a '~a'" task-id (or client-request-id "-"))

277

task-id)))

278

279

(defgeneric write-import-queue-headers (header-stream request repository headers context)

280

(:method ((destination pathname) request repository headers context)

281

     (with-open-file (stream destination :direction :output :if-does-not-exist :create :if-exists :supersede)

282

(write-import-queue-headers stream request repository headers context)

283

destination))

284

(:method ((destination stream) request repository headers context)

285

(format destination "~a /~A/service~@[?~{~@[~a=~]~a~^&~}~] HTTP/1.1~C~C"

286

(http:request-method request)

287

(repository-id repository)

288

(let ((parameters (http:request-query-argument-list request))

289

(graph (graph-query-argument-lexical-form context)))

290

(append (loop for (name . value) in parameters

291

when value

292

collect name collect value)

293

(when (and graph (not (assoc "graph" parameters :test #'equalp)))

294

(if (equalp graph "default")

295

(list nil graph)

296

(list "graph" graph)))))

297

#\Return #\Linefeed)

298

(loop for (key . value) in headers

299

when value

300

do (hunchentoot::write-header-line (chunga:as-capitalized-string key) value destination))

301

(format destination "~C~C" #\Return #\Linefeed)

302

(pathname destination)))

303

304

(defgeneric read-import-queue-entry (source)

305

(:method ((source pathname))

306

(with-open-file (stream source :direction :input)

307

(read-import-queue-entry stream)))

308

(:method ((source stream))

309

(multiple-value-bind (headers method url protocol)

310

(hunchentoot::get-request-data source)

311

(declare (ignore protocol))

312

(list* method url headers))))

313

314

(defun repository-import-graph-content (repository source &rest args

315

                                                    &key (content-type mime:application/n-quads cts)

316

                                                    context method content-encoding client-request-id task-id)

317

(declare (dynamic-extent args))

318

(declare (ignore context method content-encoding client-request-id task-id))

319

(when cts

320

(setf args (copy-list args))

321

(remf args :content-type))

322

(apply #'repository-import-graph-content-type repository source content-type args))

323

324

325

326

 (defgeneric repository-import-graph-content-type (repository source content-type &key context method content-encoding client-request-id task-id)

327

   (:documentation "Import the given content into the designated repository after clearing the respective graph.

328

The source is intended to be a temporary file which caches the request content.

329

     :content-type is either that specified as the request content or the result of a local transformation.

330

:context is a graph uri.")

331

332

(:method ((repository-id string) source content-type &rest args)

333

(declare (dynamic-extent args))

334

     (apply #'repository-import-graph-content-type (dydra:repository repository-id) source content-type args))

335

336

(:method ((repository rdfcache-lmdb-repository) (source pathname) (content-type t) &key

337

;; revision-id ;; NYI : for branching

338

context (method "PUT")

339

content-encoding

340

(request http:*request*)

341

(agent (when request (http:request-agent request)))

342

(agent-id (spocq.i::agent-name agent))

343

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

344

(task-id nil)

345

(repository-id (dydra:repository-id repository)))

346

"A repository which delegates to the rdfcache implementation uses the external import program to

347

perform the import."

348

(declare (ignore content-encoding)) ;; content encoding handled by (graph-store-response :decode)

349

;; coerce the context to a value for the cli

350

(let* ((command-arguments `(,repository-id

351

"-i" ,(cli-content-type content-type) "-X" ,method

352

,@(case context

353

((nil) nil)

354

(|urn:dydra|:|default| `("-G" "+"))

355

(t `("-G" ,(iri-lexical-form context))))

356

,@(when agent-id

357

                                     `("-D" ,(format nil "agent-id=~a" agent-id)))

358

,@(when client-request-id

359

                                     `("-D" ,(format nil "agent-tag=~a" client-request-id)))

360

,(namestring (truename source))))

361

(process (run-program (dydra:executable-pathname.import)

362

command-arguments

363

                                  ;; ,@(when content-encoding `("-C" ,(cli-content-encoding content-encoding))))

364

:wait t

365

:output :stream)))

366

(cond (process

367

(unwind-protect

368

(case (run-program-exit-code process)

369

(0 (let* ((output (run-program-output process))

370

                              (revision-id (ignore-errors (when (and output (listen output)) (read-line output nil)))))

371

(unwind-protect

372

(cond (revision-id

373

                                    (flet ((ste (start-time end-time insert remove)

374

                                             (dydra:store-transaction-event :revision-id revision-id

375

                                                                            :task-id task-id

376

                                                                            :timestamp-start start-time

377

                                                                            :timestamp-end end-time

378

                                                                            :repository repository

379

                                                                            :agent agent-id

380

                                                                            :agent-tag client-request-id

381

                                                                            :inserted insert

382

                                                                            :removed remove)))

383

(let ((rr

384

                                             (if (spocq.i::repository-is-revisioned repository)

385

                                                 (let* ((rlr (rlmdb:get-revision-log-record repository revision-id)))

386

(cond (rlr

387

                                                          (ste (when rlr (timeline-location-date-time (rlmdb:revision-log-record-timestamp-begun rlr)))

388

                                                               (when rlr (timeline-location-date-time (rlmdb:revision-log-record-timestamp rlr)))

389

                                                               (when rlr (rlmdb:revision-log-record-inserted-count rlr))

390

                                                               (when rlr (rlmdb:revision-log-record-removed-count rlr)))

391

rlr)

392

(t

393

                                                          (log-warn "repository-import-graph-content: no revision log record: ~s ~s" repository revision-id))))

394

                                                 (let* ((mr (rlmdb:get-metadata-record repository)))

395

(cond (mr

396

                                                          (let ((timestamp (timeline-location-date-time (rlmdb:metadata-record-timestamp mr))))

397

                                                            (ste timestamp timestamp nil nil))

398

mr)

399

(t

400

                                                          (log-warn "repository-import-graph-content: no metadata record: ~s" repository)))))))

401

                                        (log-notice "service ~s: ~s ~s. complete: ~s"

402

                                                    task-id method repository-id (or rr revision-id))

403

rr)))

404

(t

405

                                    (log-warn "repository-import-graph-content: no revision id result: ~s"

406

command-arguments)))

407

(when output (close output)))))

408

                    (64 (log-warn "Graph import failed: ~s: ~a: invalid content type or not available" (run-program-exit-code process) repository-id)

409

                        (http:bad-request "Graph import failed: ~s: ~a: invalid content type or not available" (run-program-exit-code process) repository-id))

410

                    (65 (log-warn "Graph import failed: ~s: ~a: invalid input" (run-program-exit-code process) repository-id)

411

                        (http:bad-request "Graph import failed: ~s: ~a: invalid input" (run-program-exit-code process) repository-id))

412

(t

413

                     (log-warn "Graph import failed: ~s: ~a" (run-program-exit-code process) repository-id)

414

                     (http:bad-request "Graph import failed: ~s: ~a" (run-program-exit-code process) repository-id)))

415

(run-program-close process)))

416

(t

417

(http:internal-error "Graph import failed: no process")))))

418

419

(:method ((repository lmdb-repository) (source pathname) media-type &key

420

;; revision-id ;; NYI : for branching

421

context (method "PUT")

422

content-encoding

423

(request http:*request*)

424

(agent (when request (http:request-agent request)))

425

(agent-id (spocq.i::agent-name agent))

426

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

427

(task-id nil))

428

"The specialization the abstract lmdb-repository class covers all variants which do

429

not have specific implementation (eg. those for hdt and rdfcache variants).

430

This relies on repository-mutate, which then handles the schematic storage variants."

431

(declare (ignore content-encoding)) ;; content encoding handled by (graph-store-response :decode)

432

;; coerce the context to a value for the cli

433

(handler-case (let ((start-time (get-universal-time))

434

(count (spocq.i::repository-mutate repository source media-type

435

                                                            :agent agent

436

                                                            :context context

437

                                                            :method method)))

438

                     (let* ((insert-count (if (or (string-equal method "PUT") (string-equal method "POST")) count 0))

439

(delete-count (if (string-equal method "DELETE") count 0))

440

(mr (rlmdb:get-metadata-record repository))

441

)

442

                       (dydra:store-transaction-event :revision-id (rlmdb:metadata-record-uuid mr)

443

                                                      :task-id task-id

444

                                                      :timestamp-start (universal-time-date-time start-time)

445

                                                      :timestamp-end (universal-time-date-time (get-universal-time))

446

                                                      :repository repository

447

                                                      :agent agent-id

448

                                                      :agent-tag client-request-id

449

                                                      :inserted insert-count

450

                                                      :removed delete-count)

451

mr))

452

(error (condition)

453

(http:bad-request "Graph import failed: ~a" condition))))

454

455

(:method ((repository dydra:repository) (source pathname) (content-type mime:application/vnd.hdt) &key

456

(repository-id (dydra:repository-id repository))

457

context (method "PUT")

458

content-encoding

459

(request http:*request*)

460

(agent (when request (http:request-agent request)))

461

(agent-id (spocq.i::agent-name agent))

462

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

463

(task-id nil))

464

"For hdt content permit put and post only.

465

Wrap the operation in a standard transaction in order to

466

1. get exclusive access

467

2. generate the revision meta-data"

468

(declare (ignore context content-encoding))

469

(flet ((hdt-post (source hdt-pathname)

470

(let* ((command-arguments `(,repository-id

471

"-i"

472

,(namestring hdt-pathname)

473

,(namestring (truename source))))

474

(process (run-program (dydra:executable-pathname.hdt-merge)

475

command-arguments

476

:wait t

477

:output :stream)))

478

(cond (process

479

(case (run-program-exit-code process)

480

(0 t)

481

                         (t (http:bad-request "HDT merge failed: ~s" (run-program-exit-code process))))

482

                       (when (run-program-output process) (close (run-program-output process)))

483

(run-program-close process))

484

(t

485

(http:internal-error "HDT merge failed: no process")))))

486

(hdt-put (source hdt-pathname)

487

(let* ((command-arguments `(,(namestring (truename source))

488

,(namestring hdt-pathname)))

489

(process (run-program (dydra:executable-pathname.copy)

490

command-arguments

491

:wait t

492

:output :stream)))

493

(cond (process

494

(case (run-program-exit-code process)

495

(0 t)

496

                         (t (http:bad-request "HDT import failed: ~s" (run-program-exit-code process))))

497

                       (when (run-program-output process) (close (run-program-output process)))

498

(run-program-close process))

499

(t

500

(http:internal-error "HDT import failed: no process"))))

501

))

502

(dydra:with-open-repository (repository-id :read-only-p nil :normal-disposition :commit)

503

(let ((transaction-id (dydra:transaction-id dydra:*transaction*)))

504

(cond ((equalp method "POST")

505

(hdt-post source (dydra:repository-hdt-pathname repository)))

506

((equalp method "PUT")

507

(hdt-put source (dydra::repository-hdt-pathname repository)))

508

(t

509

(http:method-not-allowed "HDT import does not allow method: ~s" method)))

510

(flet ((ste (start-time end-time insert remove)

511

(dydra:store-transaction-event :revision-id transaction-id

512

:task-id task-id

513

                                                   :timestamp-start start-time

514

                                                   :timestamp-end end-time

515

                                                   :repository repository

516

:agent agent-id

517

                                                   :agent-tag client-request-id

518

:inserted insert

519

                                                   :removed remove)))

520

(let* ((mr (rlmdb:get-metadata-record repository)))

521

(cond (mr

522

                      (let ((timestamp (timeline-location-date-time (rlmdb:metadata-record-timestamp mr))))

523

(ste timestamp timestamp nil nil))

524

(log-notice "service ~s: ~s ~s. complete: ~s"

525

task-id method repository-id mr)

526

mr)

527

(t

528

                      (log-warn "repository-import-graph-content: no metadata record: ~s" repository)))))))))

529

#+(or) ;; above, for lmdb-repository

530

(:method ((repository rlmdb:repository) (source pathname) content-type &key

531

;; revision-id ;; NYI : for branching

532

context (method "PUT")

533

(content-encoding nil)

534

(request http:*request*)

535

(agent (when request (http:request-agent request)))

536

(agent-id (spocq.i::agent-name agent))

537

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

538

(task-id nil)

539

(repository-id (dydra:repository-id repository))

540

(start-time (get-universal-time)))

541

;; coerce the context to a value for the cli

542

(flet ((graph-import (source)

543

(multiple-value-bind (revision-id insert remove)

544

                                   (spocq.i::repository-mutate repository source content-type

545

                                                               :context context :method method

546

                                                               :agent agent)

547

(flet ((ste (start-time end-time insert remove)

548

(dydra:store-transaction-event :revision-id revision-id

549

                                                        :task-id task-id

550

                                                        :timestamp-start start-time

551

                                                        :timestamp-end end-time

552

                                                        :repository repository

553

                                                        :agent agent-id

554

                                                        :agent-tag client-request-id

555

                                                        :inserted insert

556

                                                        :removed remove)))

557

(ste (spocq.i::universal-time-date-time start-time)

558

(spocq.i::universal-time-date-time (get-universal-time))

559

insert remove)

560

(log-notice "service ~s: ~s ~s. complete: ~s"

561

task-id method repository-id revision-id)))))

562

(case (typecase content-encoding

563

(symbol content-encoding)

564

(string (find-symbol (string-upcase content-encoding) :keyword))

565

               (t (http:unsupported-media-type "Unsupported content encoding: ~a" content-encoding)))

566

((nil) (graph-import source))

567

         (:gzip (let ((decompressed-pathname (tmp-import-pathname (dydra:account (dydra:repository-account repository))

568

                                                                  (dydra:repository repository))))

569

                  (prog1 (with-open-file (input source :direction :input :element-type '(unsigned-byte 8))

570

                           (with-open-file (output decompressed-pathname :direction :output

571

                                                   :element-type '(unsigned-byte 8)

572

                                                   :if-does-not-exist :create)

573

                             (let ((process (unwind-protect (run-program "/bin/gunzip" ;; dydra:*executable-pathname.zip*

574

                                                                         `("-c" ,(namestring (truename source)))

575

                                                                         :input input :output output

576

                                                                         :environment ()  ;; isolate rapper from dydra libraries

577

                                                                         :wait t)

578

                                              (conditional-delete-file source))))

579

(when process

580

                                 (unwind-protect (when (zerop (run-program-exit-code process))

581

                                                   (graph-import decompressed-pathname))

582

(run-program-close process))))))

583

(conditional-delete-file decompressed-pathname))))

584

(t (http:unsupported-media-type "Unsupported content encoding: ~a" content-encoding)))))

585

)

586

587

588

;;; asynchronous deletion

589

590

(defgeneric repository-queue-graph-delete (request repository &key

591

task-id

592

context content-type

593

                                            notify-location notify-content-type

594

accept

595

notify-method

596

client-request-id)

597

(:documentation "given a repository, create an asynchronous deletion task.

598

This includes a request id, which is returned as the result")

599

(:method (request (repository repository) &key

600

(task-id (dydra:make-task-id))

601

context content-type notify-location (notify-content-type mime:application/json)

602

(accept notify-content-type)

603

notify-method

604

client-request-id)

605

(declare (ignore content-type))

606

(let* ((asynchronous-headers `(,@(when accept `(("Accept" . ,accept)))

607

                                    ("Authorization" . ,(http:request-header request :authorization))

608

                                    ("Asynchronous-Authorization" . ,(http:request-header request "Asynchronous-Authorization"))

609

("Asynchronous-Location" . ,notify-location)

610

                                    ("Asynchronous-Content-Type" . ,(when notify-content-type

611

                                                                      (mime:mime-type-namestring notify-content-type)))

612

                                    ("Asynchronous-Method" . ,(or notify-method :post))

613

("Request-ID" . ,task-id)

614

("Client-Request-ID" . ,client-request-id)))

615

(temp-pathname (make-pathname :name (concatenate 'string "-" task-id)

616

                                          :defaults (spocq.i::import-queue-root-pathname)))

617

            (queue-entry-pathname (make-pathname :name task-id :defaults (spocq.i::import-queue-root-pathname))))

618

(ensure-directories-exist queue-entry-pathname)

619

       (with-open-file (queue-entry-stream temp-pathname :direction :output :if-exists :error :if-does-not-exist :create)

620

(write-delete-queue-headers queue-entry-stream request repository asynchronous-headers context))

621

(rename-file temp-pathname queue-entry-pathname)

622

(dydra:log-notice "asynchronous request queued: ~a '~a'" task-id client-request-id)

623

task-id)))

624

625

(defgeneric write-delete-queue-headers (header-stream request repository headers context)

626

(:method ((destination pathname) request repository headers context)

627

     (with-open-file (stream destination :direction :output :if-does-not-exist :create :if-exists :supersede)

628

(write-import-queue-headers stream request repository headers context)

629

destination))

630

(:method ((destination stream) request repository headers context)

631

(format destination "~a /~A/service~@[?~{~@[~a=~]~a~^&~}~] HTTP/1.1~C~C"

632

(http:request-method request)

633

(repository-id repository)

634

(let ((parameters (http:request-query-argument-list request))

635

(graph (graph-query-argument-lexical-form context)))

636

(append (loop for (name . value) in parameters

637

when value

638

collect name collect value)

639

(when (and graph (not (assoc "graph" parameters :test #'equalp)))

640

(if (equalp graph "default")

641

(list nil graph)

642

(list "graph" graph)))))

643

#\Return #\Linefeed)

644

(loop for (key . value) in headers

645

when value

646

do (hunchentoot::write-header-line (chunga:as-capitalized-string key) value destination))

647

(format destination "~C~C" #\Return #\Linefeed)

648

(pathname destination)))

649

650

(defgeneric read-asynchronous-queue-entry (source)

651

(:method ((source pathname))

652

(with-open-file (stream source :direction :input)

653

(read-asynchronous-queue-entry stream)))

654

(:method ((source stream))

655

(multiple-value-bind (headers method url protocol)

656

(hunchentoot::get-request-data source)

657

(declare (ignore protocol))

658

(list* method url headers))))

659

;;; character set : utf8 & co

660

;;; content-coding : compressed or not : compress, deflate, identity

661

;;; media-type : mime types + character set

662

;;; transfer-coding : chunked or not : chunked

663

664

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

665

"A hash table to cacnoicalize http repository setting keywords.")

666

667

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

668

in '((:class "class")

669

(:default-repository-prefixes "defaultrepositoryprefixes")

670

(:description "description")

671

(:homepage "homepage")

672

(:license-id "license" "licenseid")

673

(:name "name")

674

(:if-exists "ifexists")

675

(:if-does-not-exist "ifdoes-not-exist")

676

;(:cached-slug "cachedslug")

677

(:permissable-ip-addresses "permissableipaddresses")

678

(:privacy-setting "privacysetting" "privacy")

679

(:source-repository "sourcerepository")

680

(:storage-class "storageclass")

681

(:summary "summary")

682

(:time-series-properties "timeseriesproperties")

683

(:temporal-properties "temporalproperties")

684

(:uuid "uuid")

685

(:view-name "viewname"))

686

do (loop for argument-name in argument-names

687

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

688

689

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

690

(gethash (remove-if-not #'alpha-char-p argument-name) *http-argument-to-repository-setting-map*))

691

692

(defgeneric repository-create (account repository specification)

693

(:method ((account-name string) (repository-name string) specification)

694

(if (spocq.i::account-exists-p account-name)

695

(let ((repository-id (compute-repository-id account-name repository-name))

696

(class nil))

697

(setf specification

698

(loop for (name . value) in specification

699

for key = (http-repository-setting-name name)

700

unless key

701

do (http:bad-request "Invalid repository property ~s ~s" name value)

702

if (member key '(:class))

703

do (case key

704

                        (:class (or (and (setf class (find-symbol (string-upcase value) :spocq.i))

705

                                         (subtypep class 'spocq.i:repository))

706

                                    (http:bad-request "Invalid repository class ~s" value))))

707

else collect (cons key value)))

708

(let* ((modified nil)

709

(property-list (loop for (key . value) in specification

710

collect key collect value))

711

(repository (handler-case (spocq.i:create-repository repository-id

712

                                                                       :class (or class 'spocq.i:lmdb-quad-repository)

713

                                                                       :if-exists :error

714

                                                                       :properties property-list)

715

                                (error (c) (http:bad-request "Failed to create repository: ~a: ~a: ~a"

716

                                                             repository-id specification c))))

717

(sql-repository (spocq.i::read-sql-repository :name repository-name

718

                                                               :account-name account-name)))

719

(unless (and sql-repository repository)

720

(error "repository-create: failed to create repository: ~s." repository-id))

721

(loop for (property . value) in specification

722

do (case property

723

(:license-id (let ((license (gethash (spocq.i::license-registry) value)))

724

(if license

725

                                       (setf (spocq.i::sql-repository-license-id sql-repository) license)

726

                                       (http:bad-request "Invalid licesne ~s" value)))

727

(setf modified t))

728

                    (:default-repository-prefixes (setf modified (setf (spocq.i::sql-repository-default-repository-prefixes sql-repository) value)))

729

                    (:description (setf modified (setf (spocq.i::sql-repository-description sql-repository) value)))

730

                    (:homepage (setf modified (setf (spocq.i::sql-repository-homepage sql-repository) value)))

731

                    (:permissable_ip_addresses (setf modified (setf (spocq.i::sql-repository-permissible-ip-addresses sql-repository) value)))

732

                    (:privacy_setting (setf modified (setf (spocq.i::sql-repository-privacy-setting sql-repository) (parse-integer value))))

733

                    (:summary (setf modified (setf (spocq.i::sql-repository-summary sql-repository) value)))

734

((:uuid :name :cached_slug)) ; skip

735

((nil) )))

736

(let ((cs (substitute #\- #\space repository-name)))

737

(unless (equal cs (spocq.i::sql-repository-cached-slug sql-repository))

738

(setf modified t)

739

(setf (spocq.i::sql-repository-cached-slug sql-repository) cs)))

740

(when modified

741

(spocq.i::write-sql-repository sql-repository)

742

;; synchronize only of something changed from the created default

743

(spocq.i::synchronize-repository-from-mysql nil account-name repository-name))

744

repository))

745

(http:not-found "Account not found: ~s." account-name)))

746

747

(:method ((account account) (repository-name string) specification)

748

(repository-create (dydra:account-name account) repository-name specification)))

749

750

;;; (spocq.si::repository-create "james" "test7" '(("name" . "test7")))

751

752

753

;;; asynchronous queries

754

755

(defgeneric repository-unmonitor-query (request repository &key

756

view-name)

757

(:method (request (repository repository) &key view-name)

758

(let* ((repository-path (repository-pathname repository))

759

            (view-path (merge-pathnames (make-pathname :directory '(:relative "views") :name view-name :type nil) repository-path)))

760

(when (probe-file view-path)

761

(dydra:log-notice "monitor query deleted: ~a '~a'" (repository-id repository) view-name)

762

(delete-file view-path)

763

t))))

764

765

(defgeneric repository-monitor-query (request repository query &key

766

view-name

767

task-id

768

                                             context content-type content-encoding

769

                                             notify-location notify-content-type

770

accept

771

notify-method

772

client-request-id)

773

(:documentation "given a repository and a named query, create an asynchronous query task.

774

This includes a request id, which is returned as the result")

775

(:method (request (repository repository) (query-text string) &key

776

(view-name (error "view-name is required"))

777

task-id

778

                     context content-type notify-location (notify-content-type mime:application/json)

779

(accept notify-content-type)

780

notify-method

781

client-request-id

782

content-encoding)

783

(let* ((asynchronous-headers `(("Content-Type" . ,(or content-type "application/sparql-query"))

784

,@(when accept `(("Accept" . ,accept)))

785

                                    ,@(when content-encoding `(("Content-Encoding" . ,content-encoding)))

786

                                    ("Authorization" . ,(http:request-header request :authorization))

787

                                    ("Asynchronous-Authorization" . ,(http:request-header request "Asynchronous-Authorization"))

788

("Asynchronous-Location" . ,notify-location)

789

                                    ("Asynchronous-Content-Type" . ,(when notify-content-type

790

                                                                      (mime:mime-type-namestring notify-content-type)))

791

                                    ("Asynchronous-Method" . ,(or notify-method :post))

792

                                    ;; rename the request id to keep it available for reference,

793

                                    ;; but to regenerate it for each asynchronous iteration

794

("Original-Request-ID" . ,task-id)

795

("Client-Request-ID" . ,client-request-id)))

796

(repository-path (repository-pathname repository))

797

            (view-path (merge-pathnames (make-pathname :directory '(:relative "views") :name view-name :type nil) repository-path)))

798

(ensure-directories-exist view-path)

799

       (with-open-file (queue-entry-stream view-path :direction :output :if-exists :error :if-does-not-exist :create)

800

(write-import-queue-headers queue-entry-stream request repository asynchronous-headers context)

801

(write-string query-text queue-entry-stream))

802

(dydra:log-notice "monitor query saved: ~a ~a: '~a'"

803

(repository-id repository)

804

view-name

805

(or client-request-id "-"))

806

view-name)))

807

808

(defgeneric repository-queue-query (request repository query &key

809

view-name

810

task-id

811

                                             context content-type content-encoding

812

                                             notify-location notify-content-type

813

accept

814

notify-method

815

client-request-id)

816

(:documentation "given a repository and a named query, create an asynchronous query task.

817

This includes a request id, which is returned as the result")

818

(:method (request (repository repository) (query-text string) &key

819

(view-name (error "view-name is required"))

820

(task-id (dydra:make-task-id))

821

                     context content-type notify-location (notify-content-type mime:application/json)

822

(accept notify-content-type)

823

notify-method

824

client-request-id

825

content-encoding)

826

(let* ((asynchronous-headers `(("Content-Type" . ,(or content-type "application/sparql-query"))

827

,@(when accept `(("Accept" . ,accept)))

828

                                    ,@(when content-encoding `(("Content-Encoding" . ,content-encoding)))

829

                                    ("Authorization" . ,(http:request-header request :authorization))

830

                                    ("Asynchronous-Authorization" . ,(http:request-header request "Asynchronous-Authorization"))

831

("Asynchronous-Location" . ,notify-location)

832

                                    ("Asynchronous-Content-Type" . ,(when notify-content-type

833

                                                                      (mime:mime-type-namestring notify-content-type)))

834

                                    ("Asynchronous-Method" . ,(or notify-method :post))

835

("Request-ID" . ,task-id)

836

("Client-Request-ID" . ,client-request-id)))

837

            (queue-entry-pathname (make-pathname :name task-id :defaults (spocq.i::import-queue-root-pathname))))

838

(ensure-directories-exist queue-entry-pathname)

839

       (with-open-file (queue-entry-stream queue-entry-pathname :direction :output :if-exists :error :if-does-not-exist :create)

840

(write-import-queue-headers queue-entry-stream request repository asynchronous-headers context)

841

(write-string query-text queue-entry-stream))

842

(dydra:log-notice "asynchronous query queued: ~a '~a': ~a ~a"

843

task-id

844

(or client-request-id "-")

845

(repository-id repository)

846

view-name)

847

task-id)))

848

849

#|

850

(dydra:sparql-query `(sparql:select

851

(sparql:graph ?::account

852

(sparql:bgp

853

                                      (?::account |urn:dydra|:|accessToken| ?::authToken)

854

(?::account |acl|:|owner| ?::user)))

855

(?::account ?::user ?::authToken))

856

:repository "system/system"

857

:agent (dydra:system-agent))

858

859

(parse-sparql " delete { graph ?account {?s <urn:dydra:accessToken> ?old }}

860

insert { graph ?account{ ?s <urn:dydra:accessToken> ?new . } }

861

where { graph ?account{ ?s <urn:dydra:accessToken> ?old . } }")

862

863

(defun change-auth-token (from to)

864

(dydra:sparql-query `(spocq.a:|update|

865

(spocq.a:|modify|

866

(spocq.a:|graph| ?::|account|

867

                                                   (spocq.a:|bgp| (spocq.a:|triple| ?::|s| |urn:dydra|:|accessToken| ,from)))

868

:DELETE

869

((spocq.a:|graph| ?::|account|

870

                                                    ((spocq.a:|triple| ?::|s| |urn:dydra|:|accessToken| ,from))))

871

:INSERT

872

((spocq.a:|graph| ?::|account|

873

                                                    ((spocq.a:|triple| ?::|s| |urn:dydra|:|accessToken| ,to))))))

874

:repository "system/system"

875

:agent (dydra:system-agent)))

876

877

|#