-
Notifications
You must be signed in to change notification settings - Fork 4
/
item_ops.clj
213 lines (184 loc) · 8.94 KB
/
item_ops.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
(ns clj-jargon.item-ops
(:use [clj-jargon.validations]
[clj-jargon.permissions])
(:require [clojure-commons.file-utils :as ft]
[clojure.java.io :as io]
[clojure.tools.logging :as log]
[slingshot.slingshot :refer [throw+]]
[clojure-commons.error-codes :refer [ERR_NOT_A_FOLDER ERR_NOT_WRITEABLE]]
[otel.otel :as otel]
[clj-jargon.item-info :as info])
(:import [org.irods.jargon.core.exception CatNoAccessException]
[org.irods.jargon.core.packinstr DataObjInp$OpenFlags]
[org.irods.jargon.core.pub DataTransferOperations
IRODSFileSystemAO
IRODSAccessObjectFactory]
[org.irods.jargon.core.pub.io IRODSFileReader
PackingIrodsInputStream
PackingIrodsOutputStream
IRODSFileInputStream
IRODSFileFactory]
[org.irods.jargon.core.transfer TransferStatusCallbackListener
TransferStatusCallbackListener$FileStatusCallbackResponse
TransferStatusCallbackListener$CallbackResponse
DefaultTransferControlBlock]
[java.io Closeable]))
(defn mkdir
[{^IRODSFileSystemAO cm-ao :fileSystemAO :as cm} ^String dir-path]
(validate-full-dirpath dir-path)
(validate-path-lengths dir-path)
(.mkdir cm-ao (info/file cm dir-path) false))
;; bad Exit conditions: parent Is file, or reaches zone level
(defn- mkdirs-unvalidated
[{^IRODSFileSystemAO cm-ao :fileSystemAO :as cm} ^String dir-path]
(log/trace "mkdirs-unvalidated dir-path =" dir-path)
(let [parent (ft/rm-last-slash (ft/dirname dir-path))]
(if (info/exists? cm parent)
(when (or (info/is-file? cm parent)
(= "/" (ft/dirname parent)))
(throw+ {:error_code ERR_NOT_A_FOLDER :path parent}))
(mkdirs-unvalidated cm parent))
(.mkdir cm-ao (info/file cm dir-path) false)))
(defn mkdirs
[{^IRODSFileSystemAO cm-ao :fileSystemAO :as cm} dir-path]
(validate-full-dirpath dir-path)
(validate-path-lengths dir-path)
; iRODS always returns success even when it fails to create a directory recursively.
#_(.mkdir cm-ao (file cm dir-path) true)
; Here is a work around until this bug is fixed in iRODS.
(mkdirs-unvalidated cm dir-path))
(defn delete
([cm a-path]
(delete cm a-path false))
([cm a-path force?]
(validate-path-lengths a-path)
(let [^IRODSFileSystemAO fileSystemAO (:fileSystemAO cm)
resource (info/file cm a-path)]
(if (and (:use-trash cm) (false? force?))
(if (info/is-dir? cm a-path)
(.directoryDeleteNoForce fileSystemAO resource)
(.fileDeleteNoForce fileSystemAO resource))
(if (info/is-dir? cm a-path)
(.directoryDeleteForce fileSystemAO resource)
(.fileDeleteForce fileSystemAO resource))))))
(defn move
"Moves a file/dir from source path 'source' into destination directory 'dest'.
Parameters:
source - String containing the path to the file/dir being moved.
dest - String containing the path to the destination directory. Should not end with a slash.
:admin-users (optional) - List of users that must retain ownership on the file/dir being moved.
:user (optional) - The username of the user performing the move.
:skip-source-perms? (optional) - Boolean the tells move to skip ensuring that permissions for
the admin users are correct.
:update-fn (optional) - function of two arguments (the source path and an action (keyword)))
to call to update the caller on the progress of the move"
[cm source dest & {:keys [admin-users user skip-source-perms? update-fn]
:or {admin-users #{}
skip-source-perms? false
update-fn (fn [_ _])}}]
(update-fn source :begin)
(validate-path-lengths source)
(validate-path-lengths dest)
(update-fn source :validated-path-lengths)
(let [^IRODSFileSystemAO fileSystemAO (:fileSystemAO cm)
src (info/file cm source)
dst (info/file cm dest)]
(if (info/is-file? cm source)
(.renameFile fileSystemAO src dst)
(.renameDirectory fileSystemAO src dst))
(update-fn source :did-rename)
(fix-perms cm src dst user admin-users skip-source-perms?)
(update-fn source :end)))
(defn move-all
[cm sources dest & {:keys [admin-users user update-fn]
:or {admin-users #{}
update-fn (fn [_ _])}}]
(update-fn "several paths" :begin)
(doseq [s sources] (validate-path-lengths (ft/path-join dest (ft/basename s))))
(update-fn "several paths" :validated-path-lengths)
(dorun
(map
#(move cm %1 (ft/path-join dest (ft/basename %1)) :user user :admin-users admin-users :update-fn update-fn)
sources))
(update-fn "several paths" :end))
(defn output-stream
"Returns an FileOutputStream for a file in iRODS pointed to by 'output-path'. If the file exists,
it will be truncated."
[{^IRODSFileFactory file-factory :fileFactory :as cm} output-path]
(otel/with-span [s ["output-stream"]]
(PackingIrodsOutputStream.
(.instanceIRODSFileOutputStream file-factory
(info/file cm output-path)
DataObjInp$OpenFlags/WRITE_TRUNCATE))))
(defn ^IRODSFileInputStream input-stream
"Returns a FileInputStream for a file in iRODS pointed to by 'input-path'"
[{^IRODSFileFactory file-factory :fileFactory :as cm} input-path]
(otel/with-span [s ["input-stream"]]
(validate-path-lengths input-path)
(PackingIrodsInputStream.
(.instanceIRODSFileInputStream file-factory (info/file cm input-path)))))
(defn read-file
[{^IRODSFileFactory file-factory :fileFactory :as cm} fpath buffer]
(validate-path-lengths fpath)
(.read (IRODSFileReader. (info/file cm fpath) file-factory) buffer))
(defn ^DataTransferOperations data-transfer-obj
[{^IRODSAccessObjectFactory ao-factory :accessObjectFactory
irods-account :irodsAccount}]
(.getDataTransferOperations ao-factory irods-account))
(defn copy
[cm source dest]
(validate-path-lengths source)
(validate-path-lengths dest)
(let [dto (data-transfer-obj cm)
res (or (:defaultResource cm) "")]
(.copy dto source res dest nil nil)))
(defn copy-stream
[cm ^Closeable istream user dest-path & {:keys [set-owner?] :or {set-owner? true}}]
(otel/with-span [s ["copy-stream"]]
(validate-path-lengths dest-path)
(let [^Closeable ostream (output-stream cm dest-path)]
(try
(otel/with-span [s ["io/copy"]] (io/copy istream ostream))
(finally
(otel/with-span [s ["close streams"]]
(.close istream)
(.close ostream))
(when set-owner?
(set-owner cm dest-path user :known-type :file))))
(info/stat cm dest-path))))
(def continue TransferStatusCallbackListener$FileStatusCallbackResponse/CONTINUE)
(def skip TransferStatusCallbackListener$FileStatusCallbackResponse/SKIP)
(def cancel TransferStatusCallbackListener$CallbackResponse/CANCEL)
(def no-for-all TransferStatusCallbackListener$CallbackResponse/NO_FOR_ALL)
(def no-this-file TransferStatusCallbackListener$CallbackResponse/NO_THIS_FILE)
(def yes-for-all TransferStatusCallbackListener$CallbackResponse/YES_FOR_ALL)
(def yes-this-file TransferStatusCallbackListener$CallbackResponse/YES_THIS_FILE)
(def tcb (DefaultTransferControlBlock/instance))
(defn transfer-callback-listener
"Returns an instance of TransferStatusCallbackListener with the overallStatusCallback(),
statusCallback(), and transferAsksWhetherToForceOperation() functions delegated to the
functions passed in."
[overall-status-callback-fn status-callback-fn transfer-asks-fn]
(reify TransferStatusCallbackListener
(overallStatusCallback [_ transfer-status]
(overall-status-callback-fn transfer-status))
(statusCallback [_ transfer-status]
(status-callback-fn transfer-status))
(transferAsksWhetherToForceOperation [_ abs-path collection?]
(transfer-asks-fn abs-path collection?))))
(defn iput
"Transfers local-path to remote-path, using tcl as the TransferStatusCallbackListener.
tcl can also be set to nil."
[cm local-path remote-path tcl]
(try
(let [dto (data-transfer-obj cm)]
(.putOperation dto local-path remote-path "" tcl nil))
(catch CatNoAccessException _
(throw+ {:error_code ERR_NOT_WRITEABLE :path remote-path}))))
(defn iget
"Transfers remote-path to local-path, using tcl as the TransferStatusCallbackListener"
([cm remote-path local-path tcl]
(iget cm remote-path local-path tcl tcb))
([cm remote-path local-path tcl control-block]
(let [dto (data-transfer-obj cm)]
(.getOperation dto remote-path local-path "" tcl control-block))))