Skip to content

Commit d75f13d

Browse files
thiennamdinhthiennamdinh
committed
partial work
1 parent 9913442 commit d75f13d

File tree

10 files changed

+1353
-137
lines changed

10 files changed

+1353
-137
lines changed

‎compose/file-system/Dockerfile‎

Lines changed: 3 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,8 @@
11
FROM ghcr.io/sandialabs/sync-journal/journal-sdk:1.0.3
22

3-
ARG REPOSITORY=https://raw.githubusercontent.com/sandialabs/sync-records/965c839ac6bed6db24541ba642089e8fa8063633/lisp/
4-
5-
RUN wget $REPOSITORY/record.scm
6-
RUN wget $REPOSITORY/control.scm
7-
RUN wget $REPOSITORY/ledger.scm
8-
9-
COPY run.sh file-system.scm .
3+
ARG REPOSITORY=https://raw.githubusercontent.com/sandialabs/sync-records/28818b41c1660db0eb81b05620972f7220b20b1b/lisp/
104

5+
COPY *.scm .
116
COPY run.sh .
127

13-
CMD ./run.sh
8+
ENTRYPOINT ["./run.sh"]

‎compose/file-system/control.scm‎

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
'(lambda (record secret-hash query)
2+
(define (authenticate secret)
3+
(if (not (equal? secret-hash (sync-hash (expression->byte-vector secret))))
4+
(error 'authentication-failure "Could not identify as self")))
5+
6+
(define (less? x y)
7+
(cond ((and (number? x) (number? y)) (< x y))
8+
((and (number? x) (not (number? y))) #t)
9+
((and (not (number? x)) (number? y)) #f)
10+
(else (string<=? (symbol->string x) (symbol->string y)))))
11+
12+
(define result
13+
(cond ((eq? (car query) '*record*)
14+
(authenticate (cadr query))
15+
((eval (caddr query)) record))
16+
((eq? (car query) '*step*)
17+
(authenticate (cadr query))
18+
(let ((names (cadr ((record 'get) '(control step)))))
19+
(let loop ((names (sort! names less?)) (rets '()))
20+
(if (null? names) (reverse rets)
21+
(let ((ret (sync-call
22+
`(*record*
23+
,(cadr query)
24+
(lambda (record)
25+
(let* ((path '(control step ,(car names)))
26+
(expr (cadr ((record 'get) path))))
27+
((eval expr) record)))) #t)))
28+
(loop (cdr names) (cons (cons (car names) ret) rets)))))))
29+
((eq? (car query) '*local*)
30+
(authenticate (cadr query))
31+
(let ((function ((record 'get) `(control local ,(caaddr query)))))
32+
(if (eq? (car function) 'nothing)
33+
(error 'unknown-function "Function not found")
34+
(apply (eval (cadr function))
35+
(cons record (cdaddr query))))))
36+
(else
37+
(let ((function ((record 'get) `(control remote ,(car query)))))
38+
(if (eq? (car function) 'nothing)
39+
(error 'unknown-function "Function not found")
40+
(apply (eval (cadr function))
41+
(cons record (cdr query))))))))
42+
((record 'set!) '(control scratch) #f)
43+
result)

‎compose/file-system/docker-compose.yml‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,9 @@ services:
2626
- ./data-back:/srv/data-back
2727

2828
journal:
29-
image: ghcr.io/sandialabs/sync-services/ledger:1.0.1
29+
# image: ghcr.io/sandialabs/sync-services/ledger:1.0.1
30+
build:
31+
context: .
3032
container_name: journal
3133
networks:
3234
- docker

‎compose/file-system/file-system.scm‎

Lines changed: 86 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -1,49 +1,98 @@
1-
(lambda (record seret)
2-
(define file-system-attributes
3-
'(lambda (ledger path)
4-
'()))
1+
;; goals:
2+
;; - transparently read even non-fs file systems
3+
;; - support arbitrary metadata
4+
;; - don't be too linux-y
55

6-
(define file-system-dir-read
7-
'(lambda (ledger path)
8-
'()))
96

10-
(define file-system-dir-make!
11-
'(lambda (ledger path)
12-
'()))
7+
(lambda (record)
138

14-
(define file-system-dir-delete!
15-
'(lambda (ledger path)
16-
'()))
9+
(define file-system-set-meta!
10+
'(lambda (record meta)
11+
((ledger 'set!) '(*state* *file-system* meta) meta)))
1712

18-
(define file-system-file-make!
13+
(define file-system-read-data
1914
'(lambda (ledger path)
20-
'()))
15+
(let ((result ((ledger 'get) path)))
16+
(if (and (eq? (car result) 'object) (not (byte-vector? (cadr object))))
17+
(list (car result) (object->string (cadr result)))
18+
result))))
2119

22-
(define file-system-file-read
20+
(define file-system-read-meta
2321
'(lambda (ledger path)
24-
'()))
22+
((ledger 'get) (append (list (car path) *file-system*) (cdr path) '(*meta*)) meta)))
23+
24+
(define file-system-read
25+
`(lambda (ledger path)
26+
`((data (,,file-system-read-data ledger path))
27+
(meta (,,file-system-read-meta ledger path)))))
28+
29+
(define file-system-make-directory!
30+
'(lambda (ledger path meta)
31+
((ledger 'set) path #f)
32+
((ledger 'set) (append (list (car path) *file-system*) (cdr path) '(*meta*)) meta)))
2533

26-
(define file-system-file-write!
27-
'(lambda (ledger path value)
28-
'()))
34+
(define file-system-set-meta!
35+
'(lambda (ledger path value meta)
36+
((ledger 'set) (append (list (car path) *fs*) (cdr path)) meta)))
2937

30-
(define file-system-file-delete!
38+
(define file-system-edit-meta!
39+
'(lambda (ledger path value meta)
40+
(let ((meta-path (append (list (car path) *fs*) (cdr path) '(*meta*))))
41+
(let ((meta-store ((ledger get) meta-path)))
42+
(make-hash-table meta-old)
43+
(let loop ((ls meta))
44+
(if (null? ls) #t
45+
(begin (set! (meta-store (caar ls)) (cadar ls))
46+
(loop (cdr ls)))))
47+
(let ((final (map (lambda (x y) (list x y)) meta-store)))
48+
((ledger 'set!) meta-path (if (null? final) #f final)))))))
49+
50+
(define file-system-write-file!
51+
'(lambda (ledger path value meta)
52+
(let ((meta-path (append (list (car path) *fs*) (cdr path) '(*meta*))))
53+
((ledger 'set!) path value)
54+
((ledger 'set!) path meta))))
55+
56+
(define file-system-append-file!
57+
'(lambda (ledger path value meta)
58+
(let ((meta-path (append (list (car path) *fs*) (cdr path) '(*meta*)))
59+
(previous ((ledger 'get) path)))
60+
(if (not (byte-vector? previous))
61+
(error 'type-error "Cannot append to non-byte-vector file"))
62+
((ledger 'set!) path (append previous value))
63+
((ledger 'set!) path meta))))
64+
65+
(define file-system-symlink!
66+
'(lambda (ledger path dest)
67+
(let ((meta-path (append (list (car path) *fs*) (cdr path) '(*meta*))))
68+
((ledger 'set!) meta-path `(symlink ,dest)))))
69+
70+
(define file-system-rename!
71+
'(lambda (ledger path dest)
72+
(let ((meta-path (append (list (car path) *fs*) (cdr path) '(*meta*)))
73+
(meta-dest (append (list (car path) *fs*) (cdr path) '(*meta*))))
74+
((ledger 'set!) path dest)
75+
((ledger 'set!) meta-path meta-dest))))
76+
77+
(define file-system-remove!
3178
'(lambda (ledger path)
32-
'()))
33-
34-
(let loop ((functions '(file-system-attributes
35-
file-system-dir-read
36-
file-system-dir-make!
37-
file-system-dir-delete!
38-
file-system-file-make!
39-
file-system-file-read
40-
file-system-file-write!
41-
file-system-file-delete!)))
42-
(if (null? functions) #t
43-
;; todo: wrap the function to access ledger
44-
;; - pass in ledger instead of record
45-
;; - format path into a valid path
46-
;; - format output into "JSON" format
47-
((record 'set!) `(control local ,(car functions)) (eval (car functions)))))
79+
(let ((meta-path (append (list (car path) *fs*) (cdr path) '(*meta*))))
80+
((ledger 'set!) meta-path #f))))
81+
82+
(let loop ((names '(file-system-set-meta!
83+
file-system-read
84+
file-system-read-data
85+
file-system-read-meta
86+
file-system-make-directory!
87+
file-system-set-meta!
88+
file-system-edit-meta!
89+
file-system-write-file!
90+
file-system-append-file!)))
91+
(if (null? names) #t
92+
(let ((wrapped `(lambda (record)
93+
(let ((ledger ((record 'get) (control library ledger))))
94+
(,(eval (car names)) ledger)))))
95+
((record 'set!) `(control local ,(car names)) wrapped)
96+
(loop (cdr names)))))
4897

4998
"Installed file system extension")

0 commit comments

Comments
 (0)