I was curious, your honor...

I picked up Racket, which is a Lisp variant,  with the intent on building a decentralized computing engine (for a security class, I didn't want to run JohnTheRipper distributed in the class because it seemed like a free ride, and I was in the class to learn, dammit).  So I wrote my own distributed cracker.  Then it turned into a botnet.  Then, it evolved into an operating system.  SO, that being set, the code has evolved with my interests over the course of time and has come into a rather (incomplete) working operating system that (once connected to other nodes) will update itself from other nodes and update other nodes (with either running processes or os patches).  Since it was a while since I created this, and it's been a while since I've looked at it, what I'm pasting may not be complete (but it should be).

1. #lang racket/base
2. (require racket/tcp)
3. ;(require (lib "trace.ss"))
4. (define SYSTEM_messages '())
5. (define SYSTEM_processes '())
6. (define SYSTEM_filesystem '(1))
7. (define SYSTEM_efs '())
8. (define SYSTEM_quit '())
9. (define SYSTEM_kernel
10.   (lambda ()
11.     (begin
12.       (SYSTEM_prep_kernel)
13.       (SYSTEM_bootloader)
14.       (do ((index 0 0))
15.         ((eq? SYSTEM_quit 'quit) 'end)
16.         (begin
17.           (cond
18.             ((null? SYSTEM_messages))
19.             ((not (null? (car SYSTEM_messages)))
20.              (begin
21.                (SYSTEM_msg_handler (car SYSTEM_messages))
22.                (set! SYSTEM_messages (cdr SYSTEM_messages))))))))))
23. (define retrieve_index
24.   (lambda (n d)
25.     (cond
26.       ((null? d) 'null)
27.       ((eq? n 1) (car d))
28.       (else
29.        (retrieve_index (- n 1) (cdr d))))))
30. (define SYSTEM_patches
31.   (let ((patches '('patch_zero)))
32.     (lambda a
33.       (begin
34.         (cond
35.           ((eq? (car a) 'put) (set! patches (append patches (cdr a))))
36.           ((eq? (car a) 'get) (retrieve_index (cadr a) patches))
37.           ((eq? (car a) 'show) patches)
38.           (else
39.            'ERROR
40.            ))))))
41. (define SYSTEM_prep_kernel
42.   (lambda ()
43.     (begin
44.       ;(SYSTEM_create_thread 'test '(lambda () (sleep 2) (display 7) (newline)))
45.       ;(SYSTEM_create_thread 'updaterl '(lambda () (begin (updaterl))))
46.       ;(SYSTEM_create_thread 'updaterc '(lambda () (begin (updaterc "192.168.0.3"))))
47.       ;(SYSTEM_create_thread 'bsh bsh)
48.       ;(SYSTEM_create_message 'quit)  
49.       '()
50.       )))
51. (define SYSTEM_create_message
52.   (lambda (a)
53.     (cond
54.       ((eq? a 'quit) (set! SYSTEM_messages (append SYSTEM_messages (list (list 'quit))))))))
55. (define SYSTEM_kill_thread
56.   (lambda (a)
57.     (begin
58.       (SYSTEM_kill_thread-helper a SYSTEM_processes))))
59. (define SYSTEM_kill_thread-helper
60.   (lambda (t plist)
61.     (if (not (null? plist))
62.         (let ((c (car plist)))
63.           (cond
64.             ((null? plist) '(thread not found))
65.             ((eq? (car c) t)
66.              (begin
67.                (display (list 'killing 'thread t))
68.                (kill-thread (car (cddr c)))))
69.             (else
70.              (SYSTEM_kill_thread-helper t (cdr plist))))) '())))
71. (define SYSTEM_create_thread
72.   (lambda (n t)
73.     (set! SYSTEM_messages (append SYSTEM_messages (list (list 'thread (list n t)))))))
74. (define SYSTEM_msg_handler
75.   (lambda (message)
76.     (begin
77.       (cond
78.         ((eq? (car message) 'thread)
79.          (begin
80.            (display `(loading thread ,(caadr message)))
81.            (newline)
82.            (set! SYSTEM_processes (append SYSTEM_processes (list (append (cadr message) (list (thread(eval (cadadr message))))))))
83.            ))
84.         ((eq? (car message) 'kill)
85.          (begin
86.            (SYSTEM_kill_thread (cdr message))
87.            ;add a way to take this out of system processes
88.            ))
89.         ((eq? (car message) 'quit) (set! SYSTEM_quit 'quit))))))
90. (define vversion 1)
91. (define (updaterl)
92.   (let ((l (tcp-listen 2000)))
93.     (let-values (((sin sout) (tcp-accept l)))
94.       (begin
95.         (file-stream-buffer-mode sin 'none)
96.         (file-stream-buffer-mode sout 'none)
97.         (if (string=? (symbol->string (read sin)) "update")
98.             (begin
99.               (write 'vversion? sout)
100.               (newline sout)
101.               (let* ((new_vversion (read sin)))
102.                 (begin
103.                   (cond
104.                     ((> new_vversion vversion)
105.                      (begin
106.                        (write 'updateme sout) (newline sout)
107.                        (write vversion sout) (newline sout)
108.                        (SYSTEM_patches 'put (read sin))
109.                        (set! vversion (+ vversion 1))))
110.                     ((< new_vversion vversion)
111.                      (begin
112.                        (write 'updatingyou sout) (newline sout)
113.                        (write (SYSTEM_patches 'get (+ new_vversion 1)) sout) (newline sout)))
114.                     (else
115.                      (write 'identical sout) (newline sout)))))) '())
116.         (close-output-port sout)
117.         (close-input-port sin)
118.         (tcp-close l)
119.         (SYSTEM_create_thread 'updater '(lambda () (begin (updaterl))))))))
120. (define updaterc
121.   (lambda (server)
122.     (let-values (((sin sout) (tcp-connect server 2000)))
123.       (begin
124.         (file-stream-buffer-mode sin 'none)
125.         (file-stream-buffer-mode sout 'none)
126.         (write 'update sout)
127.         (newline sout)
128.         (read sin)
129.         (write vversion sout)
130.         (newline sout)
131.         (let ((cmd (read sin)))
132.           (begin
133.             (cond
134.               ((eq? cmd 'identical) (display '(identical)))
135.               ((eq? cmd 'updateme)
136.                (let ((previous_vversion (read sin)))
137.                  (begin
138.                    (write (SYSTEM_patches 'get (+ previous_vversion 1)) sout)
139.                    (display `(patching server ,previous_vversion to ,vversion))
140.                    (newline)
141.                    (sleep 1)
142.                    (updaterc server))))
143.               ((eq? cmd 'updatingyou)
144.                (begin
145.                  (SYSTEM_patches 'put (read sin))
146.                  (set! vversion (+ vversion 1))
147.                  (display `(patching from ,(- vversion 1) to ,vversion))
148.                  (newline)
149.                  (updaterc server))))))))))
150. (define SYSTEM_bootloader
151.   (lambda ()
152.     (begin
153.       (if (not (file-exists? "fs"))
154.           (begin
155.             (display "Creating File System")(newline)
156.             (SYSTEM_bootloader-write)) '())
157.       (begin
158.         (display "Loading Bootloader")(newline)
159.         (set! SYSTEM_filesystem (SYSTEM_bootloader-load "fs"))
160.         (display "Loading File System")(newline)
161.         (set! SYSTEM_efs (cdr SYSTEM_filesystem))
162.         (display "Loading Operating System")(newline)
163.         (display (car (cdr (caar SYSTEM_filesystem))))))))
164. (define SYSTEM_bootloader-write
165.   (lambda ()
166.     (let ((fport (open-output-file "fs")) (bl 'bootloader) (fs '(SYSTEM_create_thread 'bsh bsh)))
167.       (begin
168.         (print `(,bl ,fs) fport)
169.         (close-output-port fport)))))
170. (define SYSTEM_bootloader-load
171.   (lambda (fname)
172.     (let ((fport (open-input-file fname)))
173.       (SYSTEM_bootloader-load_file fport))))
174. (define SYSTEM_bootloader-load_file
175.   (lambda (port)
176.     (let ((rec (read port)))
177.       (if (eof-object? rec)
178.           '()
179.           (cons rec (SYSTEM_bootloader-load_file port))))))
180. (define BSH_quit 0)
181. (define inp 0)
182. (define bsh
183.   (lambda ()
184.     (begin
185.       (do ((indexx 0 0))
186.         ((eq? BSH_quit 1) 'bsh_killed)
187.         (begin
188.           (if (eq? BSH_quit 0) (set! inp (read)) '())
189.           (cond
190.             ((and (symbol? inp) (eq? inp 'shutdown)) (set!  SYSTEM_quit 'quit))
191.             ((and (symbol? inp) (eq? inp 'quit)) (set! BSH_quit 1))
192.             (else
193.              (begin
194.                (display (eval inp))
195.                (newline))))))
196.       (SYSTEM_kill_thread 'bsh))))
197. (define file_read
198.   (lambda (fname)
199.     (read_fs_helper fname SYSTEM_filesystem)))
200. (define read_fs_helper
201.   (lambda (fname flist)
202.     (cond
203.       ((null? flist) '(file not found))
204.       ((eqv? fname (caar flist)) (car (cdr (car flist))))
205.       (else
206.        (read_fs_helper fname (cdr flist))))))
207. (define file_write
208.   (lambda (fname fdata)
209.     (write_fs_helper fname fdata '() SYSTEM_filesystem)))
210. (define write_fs_helper
211.   (lambda (fname fdata flistL flistR)
212.     (cond
213.       ((null? flistR) (set! SYSTEM_filesystem (append SYSTEM_filesystem `(,`(,fname ,fdata)))))
214.       ((eqv? fname (caar flistR)) (set! SYSTEM_filesystem `(,`,(append flistL (list (cons fname (consfdata (cdr flistR))))))))
215.       (else
216.        (write_fs_helper fname fdata (append flistL (car flistR)) (cdr flistR))))))
217. (define clear_fs_cache
218.   (lambda ()
219.     (let ((fport (open-output-file "fs" 'truncate)) (fs SYSTEM_filesystem))
220.       (begin
221.         (print fs fport)
222.         (close-output-port fport)
223.         '()))))
224. (define update
225.   (lambda (a)
226.     (begin
227.       (SYSTEM_patches 'put a)
228.       (set! vversion (+ vversion 1))
229.       `(current patch level is ,vversion))))
230. (define node_start
231.   (lambda ()
232.     (SYSTEM_create_thread 'updaterl '(lambda () (begin (updaterl))))))
233. (define node_connect
234.   (lambda (n)
235.     (SYSTEM_create_thread 'updaterc '(lambda () (begin (updaterc n))))))
236. (define help
237.   (lambda ()
238.     (begin
239.       (display '(node_start)) (newline)
240.       (display '(node_connect "IP")) (newline)
241.       (display '(update '(code))) (newline)
242.       (display '(clear_fs_cache)) (newline)
243.       '()
244.       )))
245.  (SYSTEM_kernel)