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

Kind	Covered	All	%
expression	144	246	58.5
branch	4	20	20.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

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

2

3

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

4

5

(:documentation "This file defines authorization operators for the 'org.datagraph.spocq' RDF engine."

6

7

(copyright

8

9

10

(long-description

11

"need to distinguish access authorization by reswource

12

- query post can be read

13

- configuration should require control

14

- others according to request method"))

15

16

17

(defgeneric request-access-mode (request)

18

(:documentation "Determine the access mode inherent in a request based partially on its http method.

19

It distingusihes PATCH, PUT and DELETE, as obvious write operations, but it is

20

    just a rough guess for GET and POST, as a query can be read-only with POST while an update operation

21

with GET.

22

    The final determination is made when the transaction is created, by which point the query has been

23

parsed.")

24

(:method ((request http:request))

25

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

26

(mime:application/sparql |acl|:|Read|)

27

(mime:application/graphql |acl|:|Read|)

28

(t

29

(request-access-mode (http:request-method request)))))

30

31

(:method ((request-method (eql :delete)))

32

|acl|:|Write|)

33

(:method ((request-method (eql :patch)))

34

|acl|:|Write|)

35

(:method ((request-method (eql :post)))

36

|acl|:|Write|)

37

(:method ((request-method (eql :put)))

38

|acl|:|Write|)

39

;; all other methds are just reading

40

(:method ((request-method symbol))

41

|acl|:|Read|))

42

43

44

45

(defmethod http:anonymous-resource-p ((resource persistent-resource))

46

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

47

(when resource (dydra:anonymous-access-authorized-p instance))))

48

49

(defmethod http:anonymous-resource-p ((resource anonymous-resource))

50

t)

51

52

53

54

 #+(or)                                  ; no longer control, now read/write to the specific resource

55

(defmethod http:authorize-request ((resource metadata-resource) (request http:request))

56

"Given a resource which denotes metadata - that is, authorization, configuration, profile,

57

require control access independent of request method"

58

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

59

(when instance

60

(dydra:access-authorized-p instance (http:request-agent request) |acl|:|Control|))))

61

62

(defmethod http:authorize-request ((resource http:resource) (request http:request))

63

;; the base method indicates no authorization

64

nil)

65

66

(defmethod http:authorize-request :around ((resource administrator-resource) (request http:request))

67

"Given an administrator resource require that the request agent has that status"

68

(cond ((dydra:administrator-p (http:request-agent request))

69

          (dydra:log-notice "Admin request authorized as administrator: ~s: ~s" resource (http:request-agent request))

70

t)

71

((eq (http:request-method request) :options)

72

;; not non-administrator options on admin resource

73

nil)

74

((call-next-method)

75

          (dydra:log-notice "Admin request authorized as user: ~s: ~s" resource (http:request-agent request))

76

t)

77

(t

78

nil)))

79

80

(defmethod http:authorize-request :around ((resource operations-resource) (request http:request))

81

"Given an operation resource allow the operation user without auth configuration"

82

   (cond ((and (dydra:user-p (http:request-agent request)) (equalp (dydra:user-name (http:request-agent request)) "operations"))

83

          (dydra:log-notice "Operation request authorized as operations: ~s: ~s" resource (http:request-agent request))

84

t)

85

((call-next-method)

86

          (dydra:log-notice "Operation request authorized as user: ~s: ~s" resource (http:request-agent request))

87

t)

88

(t

89

nil)))

90

91

(defmethod http:authorize-request :around ((resource http:resource) (request http:request))

92

;; options must always be allowed for request from browsers

93

(or (eq (http:request-method request) :options)

94

(call-next-method)))

95

96

#+(or)

97

(defmethod http:authorize-request :before (resource request)

98

(print (compute-applicable-methods #'http:authorize-request (list resource request)))

99

(print (c2mop:class-precedence-list (class-of resource))))

100

101

#+(or)

102

(defmethod http:authorize-request :before ((resource spocq.si::query-resource) (request http:request))

103

(describe resource))

104

105

(defmethod http:authorize-request ((resource query-resource) (request http:request))

106

"Given a query resource, that is a request which includes a query text as the body or as

107

the request content, require read access, independent of request method.

108

a GET can contain an update query while a POST could contain a select and the

109

final determination is at the point when the transaction is created.

110

    If no query is present, then delegate to next implementation as the request method still governs."

111

(if (query-request-p request) ;; no test for accompanying query text, to allow views

112

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

113

(or (when instance

114

;; and require at least read

115

(dydra:access-authorized-p instance (http:request-agent request) |acl|:|Read|))

116

(call-next-method)))

117

(call-next-method)))

118

119

(defmethod http:authorize-request ((resource authorized-resource) (request http:request))

120

"Require authorization for the request agent"

121

(dydra:access-authorized-p (dydra:instance-identifier resource)

122

(http:request-agent request)

123

(request-access-mode request)))

124

125

(defmethod http:authorize-request ((resource account-resource) (request http:request))

126

"Given an account reqource, if its account is bound, then if that exists, check the

127

agent's authorization wrt the mode. If the account does not exist, respond not-found."

128

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

129

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

130

(when account ; w/o the account just return nil

131

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

132

(dydra:access-authorized-p account agent (request-access-mode request))

133

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

134

135

(defmethod http:authorize-request ((resource repository-resource) (request http:request))

136

"Given a repository reqource, if its repository is bound, then if that exists, check the

137

agent's authorization wrt the mode. If the repository does not exist, respond not-found.

138

If the repository is not bound, then delegate to the respective account."

139

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

140

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

141

(if repository

142

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

143

(dydra:access-authorized-p repository agent (request-access-mode request))

144

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

145

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

146

         (when account-resource          ; necessary for operations to eg. create a new repository

147

(http:authorize-request account-resource request))))))

148

149

(defmethod http:authorize-request ((resource anonymous-resource) (request http:request))

150

t)

151

152

153

(defun request-remote-ip-address (request)

154

(or (http:request-header request :X-Forwarded-For) ;; form load-balancer

155

(http:request-header request :X-Real-IP) ;; in nginx local configuration

156

(http:request-remote-ip-address request)))

157

158

(defmethod http:authenticate-request-password ((resource http:resource) (request http:request))

159

(multiple-value-bind (user-name password) (http:request-authentication request)

160

(let ((agent (dydra:agent-authenticated-by-password (or user-name "")

161

                                                         (or password "")

162

                                                         :if-does-not-exist nil

163

                                                         :location (request-remote-ip-address request))))

164

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

165

166

167

(defmethod http:authenticate-request-token ((resource http:resource) (request http:request))

168

(let* ((token (http:request-auth-token request))

169

(location (request-remote-ip-address request))

170

(account (resource-account resource))

171

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

172

          (agent (or (dydra:agent-authenticated-by-token token :if-does-not-exist nil :location location)

173

                     (dydra:agent-authenticated-by-token token :if-does-not-exist nil :location location

174

                                                         :repository metadata-repository-id))))

175

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

176

177

178

(defmethod http:authenticate-request-session ((resource http:resource) (request http:request))

179

(let ((session-id (or (http:request-session-id request)

180

                         (rest (assoc "_dydra_session" (hunchentoot:cookies-in request) :test #'equal)))))

181

(when session-id

182

(let ((agent (dydra:agent-authenticated-by-session session-id

183

                                                          :if-does-not-exist nil

184

                                                          :location (request-remote-ip-address request))))

185

(when agent

186

(setf (http:request-agent request) agent))))))

187

188

(defmethod http:authenticate-request-location ((resource http:resource) (request http:request))

189

   "If the request includes an address - which it should, return a non-authenticated agent with just the address"

190

(let ((location (request-remote-ip-address request)))

191

(when location

192

(let ((agent (dydra:ensure-agent :location location)))

193

(setf (http:request-agent request) agent)))))

194

195

(defmethod http:authenticate-anonymous ((resource http:resource) (request http:request))

196

"If the request permits anonymous access, return an agent with nothing else"

197

(when (or (http:anonymous-resource-p resource)

198

(eq (http:request-method request) :options))

199

(let ((agent (dydra:ensure-agent)))

200

(setf (http:request-agent request) agent))))

201