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

Kind	Covered	All	%
expression	276	767	36.0
branch	8	28	28.6

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

;;; multi-threaded acceptor based on stmx

6

7

(defclass spocq-acceptor (tbnl::tbnl-acceptor)

8

((request-count

9

:initform 0 :accessor acceptor-request-count)

10

(request-count-limit

11

:initform *request-count-limit* :initarg :request-count-limit

12

:accessor acceptor-request-count-limit

13

:documentation "if a limit is set, once it is reached the server

14

stops accepting and exits.")))

15

16

(defparameter *thread-cycle-limit* 10)

17

18

(defparameter *class.taskmaster*

19

;; 'spocq-stmx-taskmaster

20

'spocq-lock-taskmaster

21

"Specify the class to use to run the spocq http server.")

22

23

(defclass spocq-query (spocq.i:query)

24

()

25

(:metaclass spocq.i::applicable-query-class))

26

27

(defclass spocq-request (tbnl:tbnl-request)

28

((id

29

:initform nil :initarg :id

30

:reader request-id

31

:documentation "Holds an optional UUID for logging and correlation with application processing:")

32

(start-time

33

:initform (get-universal-time)

34

:reader request-start-time))

35

(:documentation "extend request class to capture the uuid"))

36

37

(defclass spocq-response (tbnl:tbnl-response)

38

())

39

40

#+(or) ;; just for testing inheritance. slot names are ambiguous btw tbnl and http

41

(defclass spocq-request-response (spocq-request spocq-response http::request-response)

42

())

43

44

(defmethod http:acceptor-request-class ((acceptor spocq-acceptor))

45

*service-request-class*)

46

(defmethod http:acceptor-response-class ((acceptor spocq-acceptor))

47

*service-response-class*)

48

49

50

(defclass spocq-taskmaster (tbnl:taskmaster)

51

((thread-total-count

52

:type integer

53

:initarg :max-thread-count

54

:initform 0

55

:accessor taskmaster-thread-total-count

56

:documentation

57

"The cumulative number of threads associated with the taskmaster over time, including

58

those which have terminated.")

59

(request-count

60

:type integer

61

:initform 0

62

:accessor taskmaster-request-count

63

:documentation

64

"The cumulative number of requests associated with the taskmaster over time.")

65

(name

66

:type string :initarg :name

67

:accessor taskmaster-name

68

:documentation

69

"Serves as the stem for task thread named such that they can be found to terminate"))

70

(:documentation

71

"A spocq-taskmaster add abstract field to accumulate a total thread count

72

and to bind a name.

73

It is specialized by spocq-stmx-taskmaster and spocq-lock-taskmaster for the

74

respective implementation mechanisms while the operators are specialized for this

75

generic class."))

76

77

(defclass spocq-stmx-taskmaster (spocq-taskmaster tbnl:multi-threaded-taskmaster)

78

((max-thread-count

79

:type integer

80

:initarg :max-thread-count

81

:initform dydra:*service-request-count-limit*

82

:accessor taskmaster-max-thread-count

83

:documentation

84

"The maximum number of request threads this taskmaster will simultaneously

85

run before refusing or queueing new connections requests. If the value

86

is null, then there is no limit.")

87

(thread-count

88

:type stmx.util:tcell

89

:initform (stmx.util:tcell 0)

90

:reader get-taskmaster-thread-count

91

:documentation

92

"The number of taskmaster processing threads currently running. held in a tcell")

93

(max-accept-count

94

:type (or integer null)

95

:initarg :max-accept-count

96

:initform *http-accept-count-limit*

97

:accessor taskmaster-max-accept-count

98

:documentation

99

"The maximum number of connections this taskmaster will accept before refusing

100

new connections. If supplied, this must be greater than MAX-THREAD-COUNT.

101

The number of queued requests is the difference between MAX-ACCEPT-COUNT

102

and MAX-THREAD-COUNT.")

103

(accept-queue

104

:type stmx.util:tfifo

105

:initform (make-instance 'stmx.util:tfifo)

106

:reader taskmaster-accept-queue

107

:documentation

108

"A queue into which the acceptor process enters request sockets and from which

109

the worker threads retrieve them for service. No explicit count is obtained -

110

the length is not permitted to grow above the delta between the maximum thread

111

and accept counts."))

112

(:documentation

113

"A spocq-taskmaster specializes multi-threaded-taskmaster to associate a thread pool with

114

a request socket queue. The pool is created at a configured size upon instantiation

115

and regulates itself such that an expiring thread creates a replacement to maintain the

116

configured complement. The request queue is a simple fifo into which the acceptor thread

117

enters request a socket upon receipt and out of which the worker threds contest for a

118

socket to serve. If the taskmaster is configured with a maximum 'accept count', that will

119

constrain the length of this queue.

120

It maintains neither an explicit request count nor an explicit thread pool. The count

121

is computed from the request length and the thread start/stop protocol just

122

maintains the count."))

123

124

(defclass spocq-lock-taskmaster (spocq-taskmaster tbnl:one-thread-per-connection-taskmaster)

125

()

126

(:documentation

127

"A spocq-lock-taskmaster specializes one-thread-per-connection-taskmaster to act as the

128

abstract interface to the tnbl single-trheaded implementation."))

129

130

131

(defmethod tbnl::taskmaster-report-tasks ((taskmaster spocq-taskmaster))

132

(let* ((queries (spocq.i::list-queries))

133

(count (length queries))

134

(thread-count (length (sb-thread:list-all-threads))))

135

(hunchentoot:acceptor-log-message (hunchentoot:taskmaster-acceptor taskmaster)

136

                                     :notice "query/thread count: ~s/~s" count thread-count)

137

(loop for query in queries

138

for i from 1

139

do (hunchentoot:acceptor-log-message (hunchentoot:taskmaster-acceptor taskmaster)

140

                                            :warning "active query (~s)  ~s" i query))))

141

(defmethod hunchentoot::handle-incoming-connection% ((taskmaster spocq-taskmaster) (socket t))

142

(hunchentoot::acceptor-log-message (hunchentoot::taskmaster-acceptor taskmaster)

143

                           :notice "acceptor: ~s; taskmaster: thread count ~s/~s, accept count ~s/~s, cumulative requests ~s"

144

                           (hunchentoot::acceptor-requests-in-progress (hunchentoot::taskmaster-acceptor taskmaster))

145

(hunchentoot::taskmaster-thread-count taskmaster)

146

(hunchentoot::taskmaster-max-thread-count taskmaster)

147

(hunchentoot::taskmaster-accept-count taskmaster)

148

(hunchentoot::taskmaster-max-accept-count taskmaster)

149

(taskmaster-request-count taskmaster))

150

(tbnl::taskmaster-report-tasks taskmaster)

151

(call-next-method))

152

153

(defparameter *too-many-start* nil)

154

(defparameter *too-many-backtrace* nil)

155

(defparameter *too-many-deadline* 15)

156

157

(defmethod hunchentoot::too-many-taskmaster-requests ((taskmaster spocq-taskmaster) (socket t))

158

(hunchentoot::acceptor-log-message (hunchentoot::taskmaster-acceptor taskmaster)

159

                                  :warning "too many: accept count ~s, thread count ~s, max accept count~s~@[, @~/format-iso-time/~]"

160

(hunchentoot::taskmaster-accept-count taskmaster)

161

(hunchentoot::taskmaster-thread-count taskmaster)

162

                                  (hunchentoot::taskmaster-max-accept-count taskmaster)

163

*too-many-start*)

164

(tbnl::taskmaster-report-tasks taskmaster)

165

(when *too-many-backtrace*

166

(spocq.i::backtrace-threads :stream *standard-output*)

167

(setq *too-many-backtrace* nil))

168

(cond (*too-many-start*

169

(cond ((> (- (get-universal-time) *too-many-start*) *too-many-deadline*)

170

(hunchentoot:acceptor-log-message (hunchentoot:taskmaster-acceptor taskmaster)

171

                                                   :warning "exiting")

172

(spocq.i::backtrace-threads :stream *standard-output*)

173

(spocq.i::maybe-exit-on-error 70))

174

(t

175

(hunchentoot::acceptor-log-message (hunchentoot::taskmaster-acceptor taskmaster)

176

                                                    :warning "waiting: ~/format-iso-time/ <  ~/format-iso-time/"

177

                                                    (get-universal-time) (+ *too-many-start* *too-many-deadline*)))))

178

(t

179

(setq *too-many-start* (get-universal-time))))

180

(call-next-method))

181

182

(defmethod tbnl::taskmaster-thread-count ((taskmaster spocq-stmx-taskmaster))

183

(stmx:atomic

184

(let* ((cell (get-taskmaster-thread-count taskmaster))

185

(count (stmx.util:take cell)))

186

(stmx.util:put cell count)

187

(the integer count))))

188

189

(defmethod tbnl:increment-taskmaster-thread-count ((taskmaster spocq-stmx-taskmaster))

190

(stmx:atomic

191

(let* ((cell (get-taskmaster-thread-count taskmaster))

192

(count (stmx.util:take cell)))

193

(stmx.util:put cell (1+ count)))))

194

195

(defmethod tbnl:decrement-taskmaster-thread-count ((taskmaster spocq-stmx-taskmaster))

196

(stmx:atomic

197

(let* ((cell (get-taskmaster-thread-count taskmaster))

198

(count (stmx.util:take cell)))

199

(stmx.util:put cell (1- count)))))

200

201

(defmethod tbnl::decrement-taskmaster-accept-count ((taskmaster spocq-stmx-taskmaster))

202

;; this is ignored, but must be supplied as it is intertwined with send-service-unavailable-reply

203

0)

204

205

(defgeneric tlength (place)

206

(:method ((place stmx.util:tcons))

207

(loop count place

208

while (typep place 'stmx.util:tcons)

209

do (setf place (stmx.util:trest place))))

210

(:method ((place stmx.util:tfifo))

211

(1- (tlength (stmx.util::front-of place)))))

212

213

214

(defmethod tbnl:handle-incoming-connection ((taskmaster spocq-stmx-taskmaster) socket)

215

(let ((queue (taskmaster-accept-queue taskmaster)))

216

(cond ((> (tlength queue)

217

(- (taskmaster-max-accept-count taskmaster) (taskmaster-max-thread-count taskmaster)))

218

;; 503

219

(tbnl::too-many-taskmaster-requests taskmaster socket)

220

(tbnl::send-service-unavailable-reply taskmaster socket))

221

           (t                            ; otherwise, queue the request socket and guarantee threads

222

(stmx.util:put queue socket)

223

(let* ((acceptor (tbnl:taskmaster-acceptor taskmaster))

224

(address (or (tbnl:acceptor-address acceptor) "*"))

225

(port (tbnl:acceptor-port acceptor)) )

226

(declare (ignore address port))

227

;; cannot compare the changing thread count as that races

228

(loop with count-to-create = (- (taskmaster-max-thread-count taskmaster)

229

                                              (tbnl::taskmaster-thread-count taskmaster))

230

for i below count-to-create

231

do (tbnl:start-thread taskmaster

232

                                          #'(lambda () (taskmaster-run-thread taskmaster)))))))))

233

234

(defmethod tbnl::too-many-taskmaster-requests ((taskmaster spocq-stmx-taskmaster) socket)

235

(declare (ignore socket))

236

(tbnl::acceptor-log-message (tbnl::taskmaster-acceptor taskmaster)

237

                         :warning "Can't handle a new request, too many request threads already"))

238

239

240

(defmethod tbnl:start-thread ((taskmaster spocq-taskmaster) function &rest args &key

241

(name (format nil "~a#~a"

242

(taskmaster-name taskmaster)

243

                                             (incf (taskmaster-thread-total-count taskmaster)))))

244

"nb. as run from handle-incoming-connection, this is executed by a single thread only."

245

(apply #'call-next-method taskmaster function

246

:name name

247

args))

248

249

(defmethod taskmaster-run-thread ((taskmaster spocq-stmx-taskmaster))

250

(tbnl:increment-taskmaster-thread-count taskmaster)

251

(unwind-protect (loop with queue = (taskmaster-accept-queue taskmaster)

252

with acceptor = (tbnl:taskmaster-acceptor taskmaster)

253

for thread-cycle-count from 1

254

until (tbnl::acceptor-shutdown-p acceptor)

255

for socket = (stmx:atomic (stmx.util:take queue))

256

do (tbnl:process-connection taskmaster socket)

257

until (and *thread-cycle-limit*

258

(>= thread-cycle-count *thread-cycle-limit*)))

259

(tbnl:decrement-taskmaster-thread-count taskmaster)))

260

261

(defmethod tbnl:process-connection ((taskmaster spocq-taskmaster) socket)

262

;; (incf (taskmaster-request-count taskmaster)) ;; neglect races

263

(tbnl:process-connection (tbnl:taskmaster-acceptor taskmaster) socket))

264

265

(defmethod tbnl:process-connection ((acceptor spocq-acceptor) socket)

266

(incf (taskmaster-request-count (tbnl::acceptor-taskmaster acceptor)))

267

(tbnl::acceptor-log-message acceptor

268

:notice "processing request @count ~a: ~s"

269

                               (tbnl::taskmaster-thread-count  (tbnl::acceptor-taskmaster acceptor))

270

socket)

271

(unwind-protect (call-next-method)

272

(tbnl::acceptor-log-message acceptor

273

:notice "completed request @count ~a: ~s"

274

                                 (tbnl::taskmaster-thread-count  (tbnl::acceptor-taskmaster acceptor))

275

socket)))

276

277

;;; integration with hunchentoot's activation protocol:

278

;;;

279

;;; start (acceptor)

280

;;; -> start-listening

281

;;; -> execute-acceptor (spocq-taskmaster)

282

;;; -> start-thread

283

;;; [-> accept-connections (acceptor)

284

;;; -> handle-incoming-connection (spocq-taskmaster socket)

285

;;; [-> taskmaster-run-thread

286

;;; -> acceptor-shutdown-p

287

;;; -> process-connection

288

;;;

289

;;; stop (acceptor)

290

;;; -> (setf acceptor-shutdown-p) (acceptor) ; upon which the acceptor listen and

291

 ;;;                                             ; taskmaster run threads depend

292

;;; -> shutdown (spocq-taskmaster) ; by which point the shutdown is no longer soft

293

;;; ; and anything remaining is terminated

294

295

(defmethod tbnl:execute-acceptor ((taskmaster spocq-stmx-taskmaster))

296

(let* ((acceptor (tbnl:taskmaster-acceptor taskmaster))

297

(name (tbnl::acceptor-name acceptor)))

298

(setf (taskmaster-name taskmaster) (format nil "~a-task" name))

299

(setf (tbnl::acceptor-process taskmaster)

300

(tbnl:start-thread taskmaster

301

#'(lambda () (tbnl::accept-connections acceptor))

302

:name name))))

303

304

305

306

(defmethod tbnl::shutdown ((taskmaster spocq-stmx-taskmaster))

307

;; do not need to wait for responses to drain as the stop(acceptor) caller

308

;; has already done that for the soft stop case

309

(loop with task-name = (taskmaster-name taskmaster)

310

for thread in (bt:all-threads)

311

for thread-name = (bt:thread-name thread)

312

when (and (>= (length thread-name) (length task-name))

313

(string-equal task-name thread-name :end2 (length task-name))

314

(bt:thread-alive-p thread))

315

do (progn (bt:destroy-thread thread)

316

#-sbcl(bt:join-thread thread)

317

#+sbcl(sb-thread:join-thread thread :default nil)))

318

taskmaster)

319

320

;;; request

321

322

(defmethod initialize-instance ((instance spocq-request) &rest args &key id headers-in)

323

(declare (dynamic-extent args))

324

(apply #'call-next-method instance

325

:id (or id

326

(when *request-id-header-key*

327

(http:request-header headers-in *request-id-header-key*))

328

(spocq.i::make-task-id))

329

args))

330

331

(defmethod print-object ((object spocq-request) stream)

332

(print-unreadable-object (object stream :type t :identity t)

333

(format stream "~a ~a~@[ ~a~]"

334

(_slot-value object 'tbnl::method)

335

(ignore-errors (http:request-path object))

336

(_slot-value object 'id))))

337

338

;;; resource classes

339

340

(defgeneric request-resource-url (request)

341

(:documentation "Return the identifier for the requested resource. This

342

combines the protocol, the _service_ hostname, and path components of the request.

343

Both the protocol and the service are configured for the installation such that

344

repository content is portable across hosts.")

345

(:method ((request http:request))

346

(format nil "~a://~a~a"

347

"http"

348

(spocq.i::site-name)

349

(http:request-path request))))

350

351

(defgeneric request-request-url (request)

352

(:documentation "Return the identifier for the requested resource. This

353

combines the protocol, the _host_ hostname, and path components of the request.

354

Both the protocol and the service are configured for the installation such that

355

repository content is portable across hosts.")

356

(:method ((request http:request))

357

(let ((host (http:request-header request "host")))

358

(format nil "~a://~a~a"

359

"http"

360

host

361

(http:request-path request))))

362

(:method ((resource http:resource))

363

(request-request-url (http:resource-request resource))))

364

365

366

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

367

(typecase graph

368

(null nil)

369

((eql |urn:dydra|:|default|) "default")

370

(spocq:iri (spocq:iri-lexical-form graph))

371

(spocq:blank-node (concatenate 'string "_:" (spocq:blank-node-label graph)))

372

(string graph)))

373

374

(defgeneric request-resource-location (request resource)

375

(:documentation "Return the identifier for the response location header.

376

This combines the literal request protocol, host and path with any addition named graph

377

specification. This will differ from the absolute url if a graph is present")

378

(:method ((request http:request) (resource http:resource))

379

(let ((host-name (http:request-host request)))

380

(when (equalp host-name "localhost") ;; behind a reverse proxy, this is "localhost"

381

(setf host-name (dydra:host-name)))

382

(format nil "~a://~a~a~@[?graph=~a~]"

383

"http"

384

host-name

385

(http:request-path request)

386

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

387

388

(defgeneric request-resource-relative-location (request resource)

389

(:documentation "Return the relative identifier for the response location header.

390

This includes just the path with any addition named graph

391

specification. This will differ from the absolute url if a graph is present")

392

(:method ((request http:request) (resource http:resource))

393

(format nil "~a~@[?graph=~a~]"

394

(http:request-path request)

395

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

396

397

(defgeneric query-request-p (request)

398

(:documentation "Return true iff the request includes a query.

399

This includes those which include a query parameter as well as those for which the

400

content type itself indicates the case.")

401

(:method ((request http:request))

402

(or (plusp (length (http:request-query-argument request "query")))

403

(let ((path (http:request-path request)))

404

(string-equal path "/sparql" :start1 (max 0 (- (length path) (length "/sparql")))))

405

(typecase (http:request-media-type request)

406

(mime:application/sparql-query

407

t)

408

(mime:application/x-www-form-urlencoded

409

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

410

(t nil)))))

411

412

413

(defclass resource-class (standard-class)

414

())

415

416

(defclass persistent-resource-class (resource-class dydra:persistent-class)

417

()

418

(:documentation "Specialize persistent-class to augment the initialization

419

protocol with an identifier which combines the request host and path"))

420

421

(defclass cached-resource-class (resource-class dydra:cached-class)

422

()

423

(:documentation "Specialize cached-class to augment the initialization

424

protocol with an identifier which combines the request host and path"))

425

426

(defclass cached-persistent-resource-class (cached-resource-class persistent-resource-class)

427

()

428

(:documentation "Combine caching and persistence for resources"))

429

430

(eval-when (#+lispworks :compile-toplevel :load-toplevel :execute)

431

(defmethod c2mop:validate-superclass ((subclass resource-class)

432

(superclass standard-class))

433

t)

434

(defmethod c2mop:validate-superclass ((subclass standard-class)

435

(superclass resource-class))

436

t))

437

438

(defclass resource (http:resource dydra:identified-object)

439

((instance

440

:initarg :instance :initform nil

441

:accessor resource-instance)

442

(properties

443

:initform ()

444

:reader resource-properties

445

:documentation "A list of the properties which are presented and accepted by the

446

resource through the http interface."))

447

(:default-initargs :request nil)

448

(:metaclass resource-class)

449

(:documentation "Combine an http resource with an identified object to mediate

450

    a request against some model component. It binds a persistent instance which defines the properties

451

    to be projected in terms of its own slots and to determine the identifier, but permits its own identifier

452

to be used to authorize and individual request.

453

(perhaps needs to be only an identifed object? if so, resource-model-instance must also change.)"))

454

455

(defgeneric resource-account (resource)

456

(:method ((resource resource))

457

nil))

458

459

(defclass persistent-resource (dydra:persistent-object resource)

460

()

461

(:metaclass persistent-resource-class)

462

(:documentation "Combine resource with a persistence to mediate a request against store content."))

463

464

(defclass cached-persistent-resource (dydra:cached-persistent-object persistent-resource)

465

()

466

(:metaclass cached-persistent-resource-class)

467

(:documentation "Combine resource with a persistence to mediate a request against store content."))

468

469

(defclass anonymous-resource (resource)

470

())

471

472

(defclass authorized-resource (spocq.i::authorized-resource http:resource)

473

()

474

(:documentation "a resource for which access must be authorized.

475

The object is any iri, not necessarily something persistent in metadata or the store.

476

eg. log views."))

477

478

(defclass administrator-resource (authorized-resource persistent-resource)

479

()

480

(:metaclass persistent-resource-class)

481

(:documentation "Those resources which require admin status always."))

482

483

(defclass operations-resource (authorized-resource persistent-resource)

484

()

485

(:metaclass persistent-resource-class)

486

(:documentation "Those resources which allow the operations account always."))

487

488

489

(defclass pathname-resource (authorized-resource)

490

((pathname

491

:initarg :pathname :reader resource-pathname

492

:documentation "the abstract class of resource associated with a pathname")))

493

494

(defclass system-pathname-resource (pathname-resource)

495

())

496

(defmethod spocq.i::instance-repository-id ((resource system-pathname-resource))

497

ORG.DATAGRAPH.SPOCQ.IMPLEMENTATION::*SYSTEM-REPOSITORY-ID*)

498

499

(defclass account-resource (cached-persistent-resource)

500

((instance

501

:reader resource-account :writer setf-resource-account

502

:type (or null dydra:account)

503

:documentation "The store account instance"))

504

(:metaclass cached-persistent-resource-class))

505

506

(defclass graph-resource (cached-persistent-resource)

507

((graphs

508

:initarg :graphs :initform nil

509

:accessor resource-graphs

510

:documentation "The graphs are present when the request specifies multiple contexts."))

511

(:metaclass cached-persistent-resource-class)

512

(:documentation "records the graph specification from a graph-store request respective

513

a specific graph."))

514

515

 (defclass graph-store-service-resource  ()  ;;; maybe also specialize graph-resource not just mix in to repositor-resource

516

()

517

(:metaclass cached-persistent-resource-class)

518

(:documentation "a protocol class to specialize decoding"))

519

520

 (defclass graph-store-binary-resource  ()  ;;; maybe also specialize graph-resource not just mix in to repositor-resource

521

()

522

(:metaclass cached-persistent-resource-class)

523

(:documentation "a protocol class to permit arbitrary content."))

524

525

(defclass direct-graph-resource (graph-resource)

526

()

527

(:metaclass cached-persistent-resource-class)

528

(:documentation "uses the entire url as the graph store graph"))

529

530

(defclass namespace-resource (persistent-resource)

531

((prefix

532

:initarg :prefix :initform (error "prefix is required.")

533

:accessor resource-prefix)

534

(namespace-name

535

:initarg :namespace-name :initform nil

536

:accessor resource-namespace-name))

537

(:metaclass persistent-resource-class)

538

(:documentation "records the prefix specification from a request for a namespace binding."))

539

540

(defclass repository-resource (graph-resource)

541

((account-resource :initarg :account-resource

542

:accessor resource-account-resource

543

:type (or account-resource null))

544

(instance

545

:reader resource-repository :writer setf-resource-repository

546

:type (or null dydra:repository))

547

(revision

548

:reader get-resource-revision :writer setf-resource-revision

549

:type (or null dydra:repository-revision))

550

(statement-count

551

:reader get-resource-statement-count :writer setf-resource-statement-count

552

:type (or null integer)))

553

(:metaclass cached-persistent-resource-class))

554

555

(defclass service-repository-resource (cached-persistent-resource)

556

((account-resource :initarg :account-resource

557

:accessor resource-account-resource

558

:type (or account-resource null))

559

(instance

560

:reader resource-repository :writer setf-resource-repository

561

:type (or null spocq.i::service-repository)))

562

(:documentation "Specialize a repository resource to account for the access to a remote location.

563

THis without provisions for revision or graph attributes."))

564

565

(defclass metadata-resource (persistent-resource)

566

()

567

(:metaclass persistent-resource-class)

568

(:documentation

569

"Designate some meta-resource with respect to an account

570

or a repository. This includes authorization specification, profile information

571

or configuration settings."))

572

573

(defclass query-resource (persistent-resource)

574

()

575

(:metaclass spocq.i::persistent-class)

576

(:documentation

577

"Designate a resource which effects a query operation.

578

In this case, the various request method is not significant wrt access

579

authorization, as that mode depends on the query form"))

580

581

(defclass authorization-resource (metadata-resource)

582

()

583

(:metaclass persistent-resource-class))

584

585

(defclass configuration-resource (metadata-resource)

586

((property

587

:initform nil :initarg :property

588

:accessor configuration-resource-property

589

:documentation "provide for requests respective a specific property"))

590

(:metaclass persistent-resource-class))

591

592

(defclass profile-resource (metadata-resource)

593

()

594

(:metaclass persistent-resource-class))

595

596

(defclass authorization-repository-resource (authorization-resource repository-resource)

597

()

598

(:metaclass persistent-resource-class))

599

600

(defclass configuration-repository-resource (configuration-resource repository-resource)

601

()

602

(:metaclass persistent-resource-class))

603

604

(defclass profile-repository-resource (profile-resource repository-resource)

605

()

606

(:metaclass persistent-resource-class))

607

608

(defclass authorization-account-resource (authorization-resource account-resource)

609

()

610

(:metaclass persistent-resource-class))

611

612

(defclass configuration-account-resource (configuration-resource account-resource)

613

()

614

(:metaclass persistent-resource-class))

615

616

(defclass profile-account-resource (profile-resource account-resource)

617

()

618

(:metaclass persistent-resource-class))

619

620

(defclass user-resource (cached-persistent-resource)

621

((user

622

:initform nil :initarg :user

623

:reader resource-user :writer setf-resource-user))

624

(:metaclass cached-persistent-resource-class))

625

626

#+(or) ; obsolete

627

(modpackage :org.datagraph.presentation-codec

628

629

630

(:import-from |http://creativecommons.org/ns#| |license|))

631

632

#+(or) ; obsolete

633

(modpackage :org.datagraph.store-codec

634

(:import-from |acl| |owner|) ; present in the store interface only

635

636

637

(:import-from |http://creativecommons.org/ns#| |license|))

638

639

640

(defgeneric resource-report-mode (resource)

641

(:method ((resource persistent-resource))

642

'dydra:sparql))

643

644

645

(defgeneric resource-model-instance (resource)

646

(:documentation "Return the instance which is the effective object of the operation

647

which is implicit in the request. For an account resource, this is primarily the

648

account, and anlogously, for a repository is is primarily the repository, but

649

particular operations, such as those directed at the configuration, will expect

650

not the primary instnace, but the attached metadata.")

651

(:method ((resource persistent-resource))

652

resource)

653

(:method ((resource authorization-resource))

654

(dydra:resource-authorization-list (resource-instance resource)))

655

(:method ((resource configuration-resource))

656

(dydra:instance-metadata (resource-instance resource)))

657

(:method ((resource profile-resource))

658

(resource-instance resource)))

659

660

661

(defgeneric resource-identifier (resource)

662

(:documentation "Return an identifier specific to the resource.

663

The base method delegates to instance-identifier, which is initialized to be

664

the respective request uri, but it could be specialized to distinguish, for example,

665

the account configuration from its

666

account.")

667

(:method ((resource persistent-resource))

668

"The default method returns the identifer of the respective instance"

669

(dydra:instance-identifier resource)))

670

671

672

(defgeneric resource-model-arguments (resource plist)

673

(:method ((resource repository-resource) (arguments list))

674

(or (rest (assoc :repository arguments :test #'string-equal))

675

arguments))

676

(:method ((resource account-resource) (arguments list))

677

(or (rest (assoc :account arguments :test #'string-equal))

678

arguments))

679

(:method ((resource t) (arguments list))

680

arguments))

681

682

683

;;; persistence support

684

;;;

685

686

(defmethod dydra:ensure-instance ((class persistent-resource-class) &rest initargs

687

&key (request http:*request*)

688

(host (http:request-header request :host))

689

path

690

                                   (identifier (dydra:intern-iri (concatenate 'string "http://"

691

                                                                              host

692

                                                                              path))))

693

(declare (dynamic-extent initargs))

694

(apply #'call-next-method class :identifier identifier initargs))

695

696

697

;;; account-resource

698

;;;

699

700

(defmethod initialize-instance ((instance account-resource) &rest initargs &key account)

701

;; instantiate and bind the designated account instance

702

;; require that it exists - otherwise 404

703

(let ((account (etypecase account

704

(null nil)

705

(string (let ((account (dydra:account account)))

706

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

707

(http:not-found "account not found: ~a" account))

708

account))

709

(dydra:account account))))

710

(apply #'call-next-method instance

711

:path (when account (concatenate 'string "/" (dydra:account-name account)))

712

initargs)

713

(setf-resource-account account instance)))

714

715

(defmethod initialize-instance ((instance profile-account-resource) &key)

716

(call-next-method)

717

#+(or)

718

(let ((account (resource-account instance)))

719

(when account

720

(let ((owner (dydra:account-user account)))

721

(when owner

722

(setf (account-owner-id instance)

723

(dydra:instance-identifier owner)))))))

724

725

726

(defgeneric resource-account-name (resource)

727

(:method ((resource account-resource))

728

(let ((account (resource-account resource)))

729

(when account

730

(dydra:account-name account)))))

731

732

733

(defmethod dydra:configuration ((resource account-resource))

734

(dydra:configuration (resource-account resource)))

735

736

737

(defmethod dydra:instance-repository-id ((resource account-resource))

738

(let ((account (resource-account resource)))

739

(when account

740

(dydra:instance-repository-id account))))

741

742

#+(or) ; use the resource's own

743

(defmethod dydra:instance-identifier ((resource account-resource))

744

(let ((account (resource-account resource)))

745

(when account

746

(dydra:instance-identifier account))))

747

748

(defmethod resource-report-mode ((resource account-resource))

749

'resource

750

;;'dydra:sparql

751

)

752

753

;;; administrator-resource

754

755

(defmethod resource-account ((resource administrator-resource))

756

(account "admin"))

757

758

;;; authorized-resource

759

760

(defmethod initialize-instance ((instance authorized-resource) &rest initargs

761

&key (path (symbol-name (type-of instance)))

762

(identifier (typecase path

763

                                               (string (spocq.i::merge-and-intern-iri path))

764

                                               (t (error "invalid path: ~s" path)))))

765

(apply #'call-next-method instance

766

:path path

767

:identifier identifier

768

initargs))

769

770

;;; repository-resource

771

;;;

772

773

(defmethod initialize-instance ((instance repository-resource) &key

774

account repository

775

revision-id revision-windows)

776

;; instantiate and bind the designated repository instance

777

;; require that it exists - otherwise 404

778

;; iff a revision or a window was specified, use that rather than the repository's current state

779

(call-next-method)

780

(let ((account (etypecase account

781

(null nil)

782

((or string dydra:account)

783

(handler-case (make-instance 'account-resource :account account)

784

(http:not-found (c) (error c))

785

(error (condition)

786

(log-warn "repository-resource: account error: ~a" condition)

787

                          (http:bad-request "repository-resource: account error: ~a" condition))))

788

(account-resource account))))

789

(setf (resource-account-resource instance) account))

790

;;nb. the request is not bound until slots are initialized

791

(let* ((revision-id (or revision-id

792

(http:resource-request-argument instance "revision-id")

793

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

794

(http:resource-request-header instance "Accept-Datetime")))

795

(revision-windows (or revision-windows

796

                                (http:resource-request-argument instance "revision-windows")

797

                                (http:resource-request-header instance "Revision-Windows")))

798

(repository (handler-case

799

(when (and account repository)

800

                           (let* ((repository-id (concatenate 'string account "/" repository))

801

                                  (repository (or (dydra:repository repository-id :if-does-not-exist nil)

802

                                                  ;; require that the repository exist - create as post to account

803

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

804

(cond (revision-id

805

                                    (spocq.i::compute-repository-revision repository revision-id))

806

(revision-windows

807

                                    (spocq.i::compute-repository-revision repository revision-windows))

808

(t

809

                                    ;; otherwise, just take the repository as given

810

                                    (spocq.i::compute-repository-revision repository "HEAD")))))

811

(http:not-found (c) (error c))

812

(error (condition)

813

                          (log-warn "repository-resource: repository error: ~a" condition)

814

                          ;; this will happen if the repository has been used by this server, but

815

                          ;; is then deleted. the end effect is not-found, so convert the error to that

816

                          (http:not-found "repository-resource: repository error: ~a" condition)))))

817

(setf-resource-repository repository instance)))

818

819

(defmethod initialize-instance ((instance profile-repository-resource) &key)

820

(call-next-method)

821

#+(or)

822

(let ((repository (resource-repository instance)))

823

(when repository

824

(setf (repository-title instance) (dydra:repository-name repository)))))

825

826

(defmethod initialize-instance ((instance service-repository-resource) &key

827

account host path)

828

;; instantiate and bind the designated service repository instance

829

(call-next-method)

830

(let ((account (etypecase account

831

(null nil)

832

((or string dydra:account)

833

(handler-case (make-instance 'account-resource :account account)

834

(http:not-found (c) (error c))

835

(error (condition)

836

(log-warn "repository-resource: account error: ~a" condition)

837

                          (http:bad-request "repository-resource: account error: ~a" condition))))

838

(account-resource account))))

839

(setf (resource-account-resource instance) account))

840

;;nb. the request is not bound until slots are initialized

841

   (let ((repository (handler-case (spocq.i::service-repository (format nil "https://~a/~{~a~^/~}" host path))

842

(error (condition)

843

                          (log-warn "service-repository-resource: repository error: ~a" condition)

844

                          ;; this will happen if the repository has been used by this server, but

845

                          ;; is then deleted. the end effect is not-found, so convert the error to that

846

                          (http:not-found "repository-resource: repository error: ~a" condition)))))

847

(setf-resource-repository repository instance)))

848

849

(defmethod initialize-instance ((instance graph-resource) &rest args &key

850

(request (http:request))

851

(graph nil g-s)

852

                                 (graphs (if g-s         ;  if the graph was a suffix in the uri, use the uri itself

853

(when graph (list graph))

854

(when request

855

                                               (or (when (http:request-query-argument request "default")

856

'("default"))

857

                                                   (append (http:request-query-arguments request "graph")

858

                                                           (http:request-query-arguments request "context"))))

859

)))

860

(declare (dynamic-extent args))

861

(setf graphs (loop for lexical-form in graphs

862

for iri = (parse-iri-parameter lexical-form)

863

when iri

864

collect iri))

865

(apply #'call-next-method instance

866

:graphs graphs

867

args))

868

869

(defmethod initialize-instance ((instance direct-graph-resource) &rest args &key

870

(request (http:request))

871

                                 (graph (spocq.i::intern-iri (request-request-url request))))

872

(declare (dynamic-extent args))

873

;; permit arguments to override

874

(when request

875

(setf graph (or (when (http:request-query-argument request "default")

876

|urn:dydra|:|default|)

877

(when (http:request-query-argument request "graph")

878

(parse-iri-parameter (http:request-query-argument request "graph")))

879

(when (http:request-query-argument request "context")

880

(parse-iri-parameter (http:request-query-argument request "context")))

881

graph)))

882

(apply #'call-next-method instance

883

:graph graph

884

args))

885

886

887

(defmethod dydra:configuration ((resource repository-resource))

888

(dydra:configuration (resource-repository resource)))

889

890

(defmethod resource-account ((resource repository-resource))

891

(resource-account (resource-account-resource resource)))

892

893

(defgeneric resource-graph (resource)

894

(:method ((resource graph-resource))

895

(first (resource-graphs resource)))

896

(:method ((resource t))

897

nil))

898

899

900

(defgeneric (setf resource-graph) (graph resource)

901

(:method (name (resource graph-resource))

902

(push name (resource-graphs resource))

903

name))

904

905

906

(defmethod dydra:instance-repository-id ((resource repository-resource))

907

(let ((repository (resource-repository resource)))

908

(when repository

909

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

910

911

#+(or) ; use the resources own

912

(defmethod dydra:instance-identifier ((resource repository-resource))

913

(let ((repository (resource-repository resource)))

914

(when repository

915

(dydra:instance-identifier repository))))

916

917

(defmethod resource-report-mode ((resource repository-resource))

918

'resource

919

;;'dydra:sparql

920

)

921

922

923

(defgeneric resource-revision (resource)

924

(:method ((resource repository-resource))

925

(or (get-resource-revision resource)

926

(setf-resource-revision (let ((repository (resource-repository resource))

927

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

928

(if revision-id

929

                                     (dydra:repository-revision revision-id :reference repository)

930

(dydra:repository-revision repository)))

931

resource))))

932

933

(defgeneric resource-statement-count (resource)

934

(:method ((resource repository-resource))

935

#+(or)

936

;; needs to account for revision changes

937

;; alternatively, use the repository's method

938

(or (get-resource-statement-count resource)

939

(setf-resource-statement-count (compute-resource-statement-count resource) resource))

940

(compute-resource-statement-count resource)))

941

942

(defgeneric compute-resource-statement-count (resource)

943

(:method ((resource repository-resource))

944

(let ((repository-id (dydra:repository-id (resource-repository resource)))

945

(revision-id (dydra:repository-revision-id (resource-revision resource)))

946

(graph (resource-graph resource)))

947

(spocq.i::with-open-transaction (repository-id :revision-id revision-id)

948

(if graph

949

(spocq.i::repository-pattern-count spocq.i::*transaction* nil nil nil graph)

950

(spocq.i::read-repository-statement-count spocq.i::*transaction*))))))

951

952

953

;;; user resource

954

955

(defmethod initialize-instance ((instance user-resource) &key user)

956

;; instantiate and bind the designated user instance

957

;; allow that it does not exist

958

(call-next-method)

959

(setf-resource-user (etypecase user

960

(null nil)

961

(string (dydra:user user))

962

(dydra:user user))

963

instance))

964

965

966

(defmethod dydra:instance-repository-id ((resource user-resource))

967

(let ((user (resource-user resource)))

968

(when user

969

(dydra:instance-repository-id user))))

970

971

972

;; conditions

973

974

(define-condition multiple-context-link-headers (http:bad-request)

975

((http.i::text :initform "Multiple context link headers were present." :allocation :class)))

976

977

#+(or) ; use the resources own

978

(defmethod dydra:instance-identifier ((resource user-resource))

979

(let ((user (resource-user resource)))

980

(when user

981

(dydra:instance-identifier user))))

982

983

984

;;; (defparameter *tm* (make-instance 'spocq-stmx-taskmaster))

985

;;; (defparameter *tm* (make-instance 'spocq-lock-taskmaster))

986

 ;;; (defparameter *a* (make-instance 'spocq-acceptor :port *host-port* :address "dev.dydra.com" :taskmaster *tm*))

987

988

#+(or)

989

(trace tbnl::start

990

tbnl::start-listening

991

tbnl:process-connection

992

tbnl:handle-incoming-connection

993

tbnl::shutdown

994

tbnl:increment-taskmaster-thread-count

995

tbnl:decrement-taskmaster-thread-count

996

usocket:socket-listen

997

taskmaster-max-accept-count

998

taskmaster-max-thread-count

999

taskmaster-thread-total-count

1000

taskmaster-accept-queue

1001

tlength

1002

tbnl:start-thread)

1003

;;; (inspect *spocq-acceptor*)

1004

;;; (inspect (tbnl::acceptor-taskmaster *spocq-acceptor*))

1005

;;;

1006

1007

#|

1008

(setf (taskmaster-max-thread-count (tbnl::acceptor-taskmaster *spocq-acceptor*)) 4)

1009

(setf (taskmaster-max-accept-count (tbnl::acceptor-taskmaster *spocq-acceptor*)) 12)

1010

variations (w / 8 max accept count, 4 test threads)

1011

x 1 : 55

1012

x 6 : 113

1013

x 10: 140 (but numerous failures due to 502's)

1014

1015

(w / 12 max accept count, 4 task threads)

1016

x 10: 210 (/ (* 233 10) 210.0) : 11.1 tests/sec

1017

1018

1019

(setf (taskmaster-max-thread-count (tbnl::acceptor-taskmaster *spocq-acceptor*)) 8)

1020

(setf (taskmaster-max-accept-count (tbnl::acceptor-taskmaster *spocq-acceptor*)) 12)

1021

x 10: 206 , which is noise and indicates there is no reason to run more request threads than cores

1022

1023

1024

(setf (taskmaster-max-thread-count (tbnl::acceptor-taskmaster *spocq-acceptor*)) 4)

1025

(setq *thread-cycle-limit* nil, 10, 4, 1)

1026

1027

x nil @ 208 sec : (/ (* 233 10) 208.0) : 11.2 / sec

1028

x 10 @ 221 sec : (/ (* 233 10) 221.0) : 10.54 / sec

1029

x 14 @ 225 sec : (/ (* 233 10) 225.0) : 10.356/ sec

1030

x 1 @ 233 sec : (/ (* 233 10) 233) : 10 / sec

1031

x nil @ 214 sec

1032

1033

./w3c/data-r2/optional/dawg-optional-complex-2_spec.rb:122

1034

rdfcache_ffi_match failed with error code 17: File exists.

1035

1036

(trace spocq.i::pipe-query

1037

spocq.i::graph-store-query

1038

spocq.i::graph-store-response

1039

)

1040

1041

|#