diff --git a/extra/bake/bake.factor b/extra/bake/bake.factor index 5e1700c6e2..d038e81394 100644 --- a/extra/bake/bake.factor +++ b/extra/bake/bake.factor @@ -1,6 +1,6 @@ -USING: kernel parser namespaces quotations vectors strings -sequences assocs tuples math combinators ; +USING: kernel parser namespaces quotations arrays vectors strings + sequences assocs tuples math combinators ; IN: bake @@ -22,6 +22,10 @@ C: splice-quot ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: ,u ( seq -- seq ) unclip building get push ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SYMBOL: exemplar : reset-building ( -- ) 1024 building set ; @@ -35,6 +39,7 @@ DEFER: bake : bake-item ( item -- ) { { [ dup \ , = ] [ drop , ] } { [ dup \ % = ] [ drop % ] } + { [ dup \ ,u = ] [ drop ,u ] } { [ dup insert-quot? ] [ insert-quot-expr call , ] } { [ dup splice-quot? ] [ splice-quot-expr call % ] } { [ dup integer? ] [ , ] } @@ -48,4 +53,9 @@ DEFER: bake : bake-items ( seq -- ) [ bake-item ] each ; : bake ( seq -- seq ) - [ reset-building save-exemplar bake-items finish-baking ] with-scope ; \ No newline at end of file + [ reset-building save-exemplar bake-items finish-baking ] with-scope ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing + diff --git a/extra/raptor/config.factor b/extra/raptor/config.factor index d06d8e3db0..ecdbf98f17 100644 --- a/extra/raptor/config.factor +++ b/extra/raptor/config.factor @@ -1,5 +1,7 @@ -USING: namespaces unix.linux.if unix.linux.ifreq unix.linux.route ; +USING: namespaces threads + unix.process unix.linux.if unix.linux.ifreq unix.linux.route + raptor.cron ; IN: raptor @@ -24,9 +26,20 @@ IN: raptor configure-route ] networking-hook set-global +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Filesystems +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +"/dev/hda1" root-device set-global + +{ "/dev/hda5" } swap-devices set-global + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! boot-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! [ + start-wait-loop ! rcS.d @@ -38,7 +51,12 @@ IN: raptor "mountdevsubfs" start-service "module-init-tools" start-service "procps.sh" start-service - "checkroot.sh" start-service + + ! "checkroot.sh" start-service + + activate-swap + mount-root + "mtab" start-service "checkfs.sh" start-service "mountall.sh" start-service @@ -76,11 +94,17 @@ IN: raptor "rmnologin" start-service schedule-cron-jobs - start-listeners - start-gettys - + + [ [ "/dev/tty2" tty-listener ] forever ] in-thread + [ [ "/dev/tty3" tty-listener ] forever ] in-thread + [ [ "/dev/tty4" tty-listener ] forever ] in-thread + [ [ "/dev/tty5" getty ] forever ] in-thread + [ [ "/dev/tty6" getty ] forever ] in-thread + ] boot-hook set-global +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! reboot-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! [ @@ -108,6 +132,8 @@ IN: raptor "reboot" stop-service ] reboot-hook set-global +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! shutdown-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! [ diff --git a/extra/raptor/cron/cron.factor b/extra/raptor/cron/cron.factor index f004ba30d5..8158a03286 100644 --- a/extra/raptor/cron/cron.factor +++ b/extra/raptor/cron/cron.factor @@ -1,5 +1,6 @@ -USING: kernel threads sequences calendar combinators.cleave combinators.lib ; +USING: kernel namespaces threads sequences calendar + combinators.cleave combinators.lib ; IN: raptor.cron @@ -46,3 +47,16 @@ C: when : schedule ( when quot -- ) [ recurring-job ] curry curry in-thread ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: cron-jobs-hourly +SYMBOL: cron-jobs-daily +SYMBOL: cron-jobs-weekly +SYMBOL: cron-jobs-monthly + +: schedule-cron-jobs ( -- ) + { 17 } f f f f [ cron-jobs-hourly get call ] schedule + { 25 } { 6 } f f f [ cron-jobs-daily get call ] schedule + { 47 } { 6 } f f { 7 } [ cron-jobs-weekly get call ] schedule + { 52 } { 6 } { 1 } f f [ cron-jobs-monthly get call ] schedule ; + diff --git a/extra/raptor/cronjobs.factor b/extra/raptor/cronjobs.factor index 394c213162..894e8e5ce7 100644 --- a/extra/raptor/cronjobs.factor +++ b/extra/raptor/cronjobs.factor @@ -1,5 +1,6 @@ -USING: kernel threads arrays sequences combinators.cleave raptor raptor.cron ; +USING: kernel namespaces threads arrays sequences combinators.cleave + raptor raptor.cron ; IN: raptor @@ -7,41 +8,33 @@ IN: raptor : fork-exec-args-wait ( args -- ) [ first ] [ ] bi fork-exec-wait ; +: run-script ( path -- ) 1array [ fork-exec-args-wait ] curry in-thread ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: cron-hourly ( -- ) ; - -: cron-daily ( -- ) - { "/etc/cron.daily/apt" - "/etc/cron.daily/aptitude" - "/etc/cron.daily/bsdmainutils" - "/etc/cron.daily/find.notslocate" - "/etc/cron.daily/logrotate" - "/etc/cron.daily/man-db" - "/etc/cron.daily/ntp-server" - "/etc/cron.daily/slocate" - "/etc/cron.daily/standard" - "/etc/cron.daily/sysklogd" - "/etc/cron.daily/tetex-bin" } - [ 1array [ fork-exec-args-wait ] in-thread drop ] each ; +[ + "/etc/cron.daily/apt" run-script + "/etc/cron.daily/aptitude" run-script + "/etc/cron.daily/bsdmainutils" run-script + "/etc/cron.daily/find.notslocate" run-script + "/etc/cron.daily/logrotate" run-script + "/etc/cron.daily/man-db" run-script + "/etc/cron.daily/ntp-server" run-script + "/etc/cron.daily/slocate" run-script + "/etc/cron.daily/standard" run-script + "/etc/cron.daily/sysklogd" run-script + "/etc/cron.daily/tetex-bin" run-script +] cron-jobs-daily set-global -: cron-weekly ( -- ) - { "/etc/cron.weekly/cvs" - "/etc/cron.weekly/man-db" - "/etc/cron.weekly/ntp-server" - "/etc/cron.weekly/popularity-contest" - "/etc/cron.weekly/sysklogd" } - [ 1array [ fork-exec-args-wait ] in-thread drop ] each ; +[ + "/etc/cron.weekly/cvs" run-script + "/etc/cron.weekly/man-db" run-script + "/etc/cron.weekly/ntp-server" run-script + "/etc/cron.weekly/popularity-contest" run-script + "/etc/cron.weekly/sysklogd" run-script +] cron-jobs-weekly set-global -: cron-monthly ( -- ) - { "/etc/cron.monthly/scrollkeeper" - "/etc/cron.monthly/standard" } - [ 1array [ fork-exec-args-wait ] in-thread drop ] each ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: schedule-cron-jobs ( -- ) - { 17 } f f f f [ cron-hourly ] schedule - { 25 } { 6 } f f f [ cron-daily ] schedule - { 47 } { 6 } f f { 7 } [ cron-weekly ] schedule - { 52 } { 6 } { 1 } f f [ cron-monthly ] schedule ; \ No newline at end of file +[ + "/etc/cron.monthly/scrollkeeper" run-script + "/etc/cron.monthly/standard" run-script +] cron-jobs-monthly set-global \ No newline at end of file diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor index b0b9c05895..e6f960cd8d 100644 --- a/extra/raptor/raptor.factor +++ b/extra/raptor/raptor.factor @@ -1,5 +1,6 @@ -USING: kernel parser namespaces threads unix.process combinators.cleave ; +USING: kernel parser namespaces threads sequences unix unix.process + combinators.cleave bake ; IN: raptor @@ -10,29 +11,29 @@ SYMBOL: reboot-hook SYMBOL: shutdown-hook SYMBOL: networking-hook +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : reload-raptor-config ( -- ) "/etc/raptor/config.factor" run-file "/etc/raptor/cronjobs.factor" run-file ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -USING: sequences unix ; +: fork-exec-wait ( pathname args -- ) + fork dup 0 = [ drop exec drop ] [ 2nip wait-for-pid drop ] if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: forever ( quot -- ) [ call ] [ forever ] bi ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : start-service ( name -- ) "/etc/init.d/" swap " start" 3append system drop ; : stop-service ( name -- ) "/etc/init.d/" swap " stop" 3append system drop ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: fork-exec-wait ( pathname args -- ) - fork dup 0 = [ drop exec drop ] [ 2nip wait-for-pid ] if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: respawn ( pathname args -- ) [ fork-exec-wait ] [ respawn ] 2bi ; - -: start-gettys ( -- ) - [ "/sbin/getty" { "getty" "38400" "tty5" } respawn ] in-thread - [ "/sbin/getty" { "getty" "38400" "tty6" } respawn ] in-thread ; +: getty ( tty -- ) `{ "/sbin/getty" "38400" , } fork-exec-args-wait ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -40,16 +41,19 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex listener ; : tty-listener ( tty -- ) - [ ] - [ ] - bi [ listener ] with-stream ; + [ ] [ ] bi + [ listener ] with-stream ; -: forever ( quot -- ) [ call ] [ forever ] bi ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: start-listeners ( -- ) - [ [ "/dev/tty2" tty-listener ] forever ] in-thread - [ [ "/dev/tty3" tty-listener ] forever ] in-thread - [ [ "/dev/tty4" tty-listener ] forever ] in-thread ; +USING: unix.linux.swap unix.linux.fs ; + +SYMBOL: root-device +SYMBOL: swap-devices + +: activate-swap ( -- ) swap-devices get [ 0 swapon drop ] each ; + +: mount-root ( -- ) root-device get "/" "ext3" MS_REMOUNT f mount drop ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -60,3 +64,4 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex : shutdown ( -- ) shutdown-hook get call ; MAIN: boot + diff --git a/extra/raptor/readme-0.1.1 b/extra/raptor/readme-0.1.1 index 303fb416c4..bb5d4c0ff8 100644 --- a/extra/raptor/readme-0.1.1 +++ b/extra/raptor/readme-0.1.1 @@ -8,9 +8,22 @@ Raptor Linux is a mod of Ubuntu 6.06 (Dapper Drake) This is unlikely to work on another version of Ubuntu, much less another Linux distribution. +*** Features *** + + * /sbin/init is replaced with Factor + * Virtual terminals managed by Factor + * Listeners run on virtual terminals + * Native support for static ip networking + * Crontab replacement + *** Install *** + # mkdir -v /etc/raptor + + # cp -v /scratch/factor/extra/raptor/{config,cronjobs}.factor /etc/raptor + ( scratchpad ) USE: raptor + ( scratchpad ) reload-raptor-config ( scratchpad ) save # mv -v /sbin/{init,init.orig} @@ -19,10 +32,6 @@ another Linux distribution. # cp -v /scratch/factor/factor.image /sbin/init.image - # mkdir -v /etc/raptor - - # cp -v /scratch/factor/extra/raptor/config.factor /etc/raptor/config.factor - *** Static IP networking *** If you use a static IP in your network then Factor can take care of diff --git a/extra/unix/linux/fs/fs.factor b/extra/unix/linux/fs/fs.factor new file mode 100644 index 0000000000..02fd357ccd --- /dev/null +++ b/extra/unix/linux/fs/fs.factor @@ -0,0 +1,25 @@ + +USING: alien.syntax ; + +IN: unix.linux.fs + +: MS_RDONLY 1 ; ! Mount read-only. +: MS_NOSUID 2 ; ! Ignore suid and sgid bits. +: MS_NODEV 4 ; ! Disallow access to device special files. +: MS_NOEXEC 8 ; ! Disallow program execution. +: MS_SYNCHRONOUS 16 ; ! Writes are synced at once. +: MS_REMOUNT 32 ; ! Alter flags of a mounted FS. +: MS_MANDLOCK 64 ; ! Allow mandatory locks on an FS. +: S_WRITE 128 ; ! Write on file/directory/symlink. +: S_APPEND 256 ; ! Append-only file. +: S_IMMUTABLE 512 ; ! Immutable file. +: MS_NOATIME 1024 ; ! Do not update access times. +: MS_NODIRATIME 2048 ; ! Do not update directory access times. +: MS_BIND 4096 ; ! Bind directory at different place. + +FUNCTION: int mount +( char* special_file, char* dir, char* fstype, ulong options, void* data ) ; + +! FUNCTION: int umount2 ( char* file, int flags ) ; + +FUNCTION: int umount ( char* file ) ; \ No newline at end of file diff --git a/extra/unix/linux/swap/swap.factor b/extra/unix/linux/swap/swap.factor new file mode 100644 index 0000000000..4cafa5723f --- /dev/null +++ b/extra/unix/linux/swap/swap.factor @@ -0,0 +1,12 @@ + +USING: alien.syntax ; + +IN: unix.linux.swap + +: SWAP_FLAG_PREFER HEX: 8000 ; ! Set if swap priority is specified. +: SWAP_FLAG_PRIO_MASK HEX: 7fff ; +: SWAP_FLAG_PRIO_SHIFT 0 ; + +FUNCTION: int swapon ( char* path, int flags ) ; + +FUNCTION: int swapoff ( char* path ) ; \ No newline at end of file diff --git a/extra/unix/process/process.factor b/extra/unix/process/process.factor index 7f06f903ac..a99611aba6 100644 --- a/extra/unix/process/process.factor +++ b/extra/unix/process/process.factor @@ -31,11 +31,23 @@ IN: unix.process ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! This is kludgy. We need a better implementation. +USING: kernel alien.c-types namespaces continuations threads assocs unix + combinators.cleave ; -USE: threads +SYMBOL: pid-wait -: wait-for-pid ( pid -- ) - dup "int" WNOHANG waitpid - 0 = [ 100 sleep wait-for-pid ] [ drop ] if ; +! KEY | VALUE +! ----------- +! pid | continuation +: init-pid-wait ( -- ) H{ } clone pid-wait set-global ; + +: wait-for-pid ( pid -- status ) [ pid-wait get set-at stop ] curry callcc1 ; + +: wait-loop ( -- ) + -1 0 tuck WNOHANG waitpid ! &status return + [ *int ] [ pid-wait get delete-at* drop ] bi* ! status ? + dup [ schedule-thread-with ] [ 2drop ] if + 250 sleep wait-loop ; + +: start-wait-loop ( -- ) init-pid-wait [ wait-loop ] in-thread ; \ No newline at end of file diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 0854754dcb..10ff7a9efa 100644 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -166,6 +166,10 @@ FUNCTION: time_t time ( time_t* t ) ; FUNCTION: int unlink ( char* path ) ; FUNCTION: int utimes ( char* path, timeval[2] times ) ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! wait and waitpid +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Flags for waitpid : WNOHANG 1 ; @@ -176,7 +180,27 @@ FUNCTION: int utimes ( char* path, timeval[2] times ) ; : WCONTINUED 8 ; : WNOWAIT HEX: 1000000 ; +! Examining status + +: WTERMSIG ( status -- value ) HEX: 7f bitand ; + +: WIFEXITED ( status -- ? ) WTERMSIG zero? ; + +: WEXITSTATUS ( status -- value ) HEX: ff00 bitand -8 shift ; + +: WIFSIGNALED ( status -- ? ) HEX: 7f bitand 1+ -1 shift 0 > ; + +: WCOREFLAG ( -- value ) HEX: 80 ; + +: WCOREDUMP ( status -- ? ) WCOREFLAG bitand zero? not ; + +: WIFSTOPPED ( status -- ? ) HEX: ff bitand HEX: 7f = ; + +: WSTOPSIG ( status -- value ) WEXITSTATUS ; + FUNCTION: pid_t wait ( int* status ) ; FUNCTION: pid_t waitpid ( pid_t wpid, int* status, int options ) ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ; diff --git a/extra/webapps/article-manager/furnace/article.furnace b/extra/webapps/article-manager/furnace/article.furnace index 41929301a6..f0647aa442 100644 --- a/extra/webapps/article-manager/furnace/article.furnace +++ b/extra/webapps/article-manager/furnace/article.furnace @@ -1,4 +1,4 @@ -<% USING: kernel io http.server namespaces sequences math html.elements random furnace webapps.article-manager webapps.article-manager.database ; %> +<% USING: kernel io http.server namespaces sequences math html.elements random furnace webapps.article-manager webapps.article-manager.database html.elements ; %> <% f "navigation" render-template %>
diff --git a/extra/webapps/article-manager/furnace/tag.furnace b/extra/webapps/article-manager/furnace/tag.furnace index 493ce2e613..a778deb9be 100644 --- a/extra/webapps/article-manager/furnace/tag.furnace +++ b/extra/webapps/article-manager/furnace/tag.furnace @@ -1,4 +1,4 @@ -<% USING: kernel io http.server namespaces sequences math html furnace webapps.article-manager.database webapps.article-manager ; %> +<% USING: kernel io http.server namespaces sequences math html furnace webapps.article-manager.database webapps.article-manager html.elements ; %> <% f "navigation" render-template %> diff --git a/misc/factor.el b/misc/factor.el index 19e29843d6..88af0a6dab 100644 --- a/misc/factor.el +++ b/misc/factor.el @@ -166,6 +166,9 @@ (beginning-of-line) (insert "! ")) +(defun factor-refresh-all () + (interactive) + (comint-send-string "*factor*" "refresh-all\n")) (define-key factor-mode-map "\C-c\C-f" 'factor-run-file) (define-key factor-mode-map "\C-c\C-r" 'factor-send-region)