Fix $or
[factor/jcg.git] / unmaintained / raptor / raptor.factor
blobc0605fe83743c672b603be17bb60035a90902f47
2 USING: kernel parser namespaces threads arrays sequences unix unix.process
3        bake ;
5 IN: raptor
7 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
9 SYMBOL: boot-hook
10 SYMBOL: reboot-hook
11 SYMBOL: shutdown-hook
12 SYMBOL: networking-hook
14 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 : reload-raptor-config ( -- )
17   "/etc/raptor/config.factor" run-file
18   "/etc/raptor/cronjobs.factor" run-file ;
20 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
22 : fork-exec-wait ( pathname args -- )
23   fork dup 0 = [ drop exec drop ] [ 2nip wait-for-pid drop ] if ;
25 : fork-exec-args-wait ( args -- ) [ first ] [ ] bi fork-exec-wait ;
27 : fork-exec-arg ( arg -- ) 1array [ fork-exec-args-wait ] curry in-thread ;
29 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
31 : forever ( quot -- ) [ call ] [ forever ] bi ;
33 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
35 : start-service ( name -- ) "/etc/init.d/" " start" surround system drop ;
36 : stop-service  ( name -- ) "/etc/init.d/" " stop"  surround system drop ;
38 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
40 : getty ( tty -- ) `{ "/sbin/getty" "38400" , } fork-exec-args-wait ;
42 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
44 USING: io io.files io.streams.lines io.streams.plain io.streams.duplex
45        listener io.encodings.utf8 ;
47 : tty-listener ( tty -- )
48   dup utf8 <file-reader> [
49     swap utf8 <file-writer> [
50       <duplex-stream> [
51         listener
52       ] with-stream
53     ] with-disposal
54   ] with-disposal ;
56 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
58 USING: unix.linux.swap unix.linux.fs ;
60 SYMBOL: root-device
61 SYMBOL: swap-devices
63 : activate-swap ( -- ) swap-devices get [ 0 swapon drop ] each ;
65 : mount-root ( -- ) root-device get "/" "ext3" MS_REMOUNT f mount drop ;
67 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
69 : start-networking ( -- ) networking-hook  get call ;
71 : set-hostname ( name -- ) `{ "/bin/hostname" , } fork-exec-args-wait ;
73 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
75 : boot     ( -- ) boot-hook     get call ;
76 : reboot   ( -- ) reboot-hook   get call ;
77 : shutdown ( -- ) shutdown-hook get call ;
79 MAIN: boot