Merge branch 'master' of git://factorcode.org/git/factor
commit
299dca3200
|
@ -54,8 +54,8 @@ M: unix-io run-process* ( desc -- )
|
|||
setup-stdio-pipe
|
||||
(spawn-process)
|
||||
] [
|
||||
2dup second close first close
|
||||
] with-fork >r first swap second r> ;
|
||||
-rot 2dup second close first close
|
||||
] with-fork first swap second rot ;
|
||||
|
||||
TUPLE: pipe-stream pid ;
|
||||
|
||||
|
|
|
@ -0,0 +1,136 @@
|
|||
|
||||
USING: namespaces unix.linux.if unix.linux.ifreq unix.linux.route ;
|
||||
|
||||
IN: raptor
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! Networking
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: configure-lo ( -- )
|
||||
"lo" "127.0.0.1" set-if-addr
|
||||
"lo" { IFF_UP } flags set-if-flags ;
|
||||
|
||||
: configure-eth1 ( -- )
|
||||
"eth1" "192.168.1.10" set-if-addr
|
||||
"eth1" { IFF_UP IFF_MULTICAST } flags set-if-flags ;
|
||||
|
||||
: configure-route ( -- )
|
||||
"0.0.0.0" "192.168.1.1" "0.0.0.0" { RTF_UP RTF_GATEWAY } flags route ;
|
||||
|
||||
[
|
||||
configure-lo
|
||||
configure-eth1
|
||||
configure-route
|
||||
] networking-hook set-global
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
[
|
||||
|
||||
! rcS.d
|
||||
|
||||
"mountvirtfs" start-service
|
||||
"hostname.sh" start-service
|
||||
"keymap.sh" start-service
|
||||
"linux-restricted-modules-common" start-service
|
||||
"udev" start-service
|
||||
"mountdevsubfs" start-service
|
||||
"module-init-tools" start-service
|
||||
"procps.sh" start-service
|
||||
"checkroot.sh" start-service
|
||||
"mtab" start-service
|
||||
"checkfs.sh" start-service
|
||||
"mountall.sh" start-service
|
||||
|
||||
start-networking
|
||||
! "loopback" start-service
|
||||
! "networking" start-service
|
||||
|
||||
"hwclock.sh" start-service
|
||||
"displayconfig-hwprobe.py" start-service
|
||||
"screen" start-service
|
||||
"x11-common" start-service
|
||||
"bootmisc.sh" start-service
|
||||
"urandom" start-service
|
||||
|
||||
! rc2.d
|
||||
|
||||
"vbesave" start-service
|
||||
"acpid" start-service
|
||||
"powernowd.early" start-service
|
||||
"sysklogd" start-service
|
||||
"klogd" start-service
|
||||
"dbus" start-service
|
||||
"apmd" start-service
|
||||
"hotkey-setup" start-service
|
||||
"laptop-mode" start-service
|
||||
"makedev" start-service
|
||||
"nvidia-kernel" start-service
|
||||
"postfix" start-service
|
||||
"powernowd" start-service
|
||||
"ntp-server" start-service
|
||||
"binfmt-support" start-service
|
||||
"acpi-support" start-service
|
||||
"rc.local" start-service
|
||||
"rmnologin" start-service
|
||||
|
||||
schedule-cron-jobs
|
||||
start-listeners
|
||||
start-gettys
|
||||
|
||||
] boot-hook set-global
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
[
|
||||
"acpi-support" stop-service
|
||||
"apmd" stop-service
|
||||
"dbus" stop-service
|
||||
"hotkey-setup" stop-service
|
||||
"laptop-mode" stop-service
|
||||
"makedev" stop-service
|
||||
"nvidia-kernel" stop-service
|
||||
"powernowd" stop-service
|
||||
"acpid" stop-service
|
||||
"hwclock.sh" stop-service
|
||||
"alsa-utils" stop-service
|
||||
"klogd" stop-service
|
||||
"binfmt-support" stop-service
|
||||
"sysklogd" stop-service
|
||||
"linux-restricted-modules-common" stop-service
|
||||
"sendsigs" stop-service
|
||||
"urandom" stop-service
|
||||
"umountnfs.sh" stop-service
|
||||
"networking" stop-service
|
||||
"umountfs" stop-service
|
||||
"umountroot" stop-service
|
||||
"reboot" stop-service
|
||||
] reboot-hook set-global
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
[
|
||||
"acpi-support" stop-service
|
||||
"apmd" stop-service
|
||||
"dbus" stop-service
|
||||
"hotkey-setup" stop-service
|
||||
"laptop-mode" stop-service
|
||||
"makedev" stop-service
|
||||
"nvidia-kernel" stop-service
|
||||
"postfix" stop-service
|
||||
"powernowd" stop-service
|
||||
"acpid" stop-service
|
||||
"hwclock.sh" stop-service
|
||||
"alsa-utils" stop-service
|
||||
"klogd" stop-service
|
||||
"binfmt-support" stop-service
|
||||
"sysklogd" stop-service
|
||||
"linux-restricted-modules-common" stop-service
|
||||
"sendsigs" stop-service
|
||||
"urandom" stop-service
|
||||
"umountnfs.sh" stop-service
|
||||
"umountfs" stop-service
|
||||
"umountroot" stop-service
|
||||
"halt" stop-service
|
||||
] shutdown-hook set-global
|
|
@ -0,0 +1,48 @@
|
|||
|
||||
USING: kernel threads sequences calendar combinators.cleave combinators.lib ;
|
||||
|
||||
IN: raptor.cron
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: when minute hour day-of-month month day-of-week ;
|
||||
|
||||
C: <when> when
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: slot-match? ( now-slot when-slot -- ? ) dup f = [ 2drop t ] [ member? ] if ;
|
||||
|
||||
: minute-match? ( now when -- ? )
|
||||
[ timestamp-minute ] [ when-minute ] bi* slot-match? ;
|
||||
|
||||
: hour-match? ( now when -- ? )
|
||||
[ timestamp-hour ] [ when-hour ] bi* slot-match? ;
|
||||
|
||||
: day-of-month-match? ( now when -- ? )
|
||||
[ timestamp-day ] [ when-day-of-month ] bi* slot-match? ;
|
||||
|
||||
: month-match? ( now when -- ? )
|
||||
[ timestamp-month ] [ when-month ] bi* slot-match? ;
|
||||
|
||||
: day-of-week-match? ( now when -- ? )
|
||||
[ day-of-week ] [ when-day-of-week ] bi* slot-match? ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: when=now? ( when -- ? )
|
||||
now swap
|
||||
{ [ minute-match? ]
|
||||
[ hour-match? ]
|
||||
[ day-of-month-match? ]
|
||||
[ month-match? ]
|
||||
[ day-of-week-match? ] }
|
||||
<--&& ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: recurring-job ( when quot -- )
|
||||
[ swap when=now? [ call ] [ drop ] if 60000 sleep ] [ recurring-job ] 2bi ;
|
||||
|
||||
: schedule ( when quot -- ) [ recurring-job ] curry curry in-thread ;
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
|
||||
USING: kernel threads arrays sequences combinators.cleave raptor raptor.cron ;
|
||||
|
||||
IN: raptor
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: fork-exec-args-wait ( args -- ) [ first ] [ ] bi fork-exec-wait ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: 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 ;
|
||||
|
||||
: 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 ;
|
||||
|
||||
: 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 <when> [ cron-hourly ] schedule
|
||||
{ 25 } { 6 } f f f <when> [ cron-daily ] schedule
|
||||
{ 47 } { 6 } f f { 7 } <when> [ cron-weekly ] schedule
|
||||
{ 52 } { 6 } { 1 } f f <when> [ cron-monthly ] schedule ;
|
|
@ -0,0 +1,62 @@
|
|||
|
||||
USING: kernel parser namespaces threads unix.process combinators.cleave ;
|
||||
|
||||
IN: raptor
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
SYMBOL: boot-hook
|
||||
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 ;
|
||||
|
||||
: 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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
USING: io io.files io.streams.lines io.streams.plain io.streams.duplex
|
||||
listener ;
|
||||
|
||||
: tty-listener ( tty -- )
|
||||
[ <file-reader> <line-reader> ]
|
||||
[ <file-writer> <plain-writer> ]
|
||||
bi <duplex-stream> [ 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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: start-networking ( -- ) networking-hook get call ;
|
||||
|
||||
: boot ( -- ) boot-hook get call ;
|
||||
: reboot ( -- ) reboot-hook get call ;
|
||||
: shutdown ( -- ) shutdown-hook get call ;
|
||||
|
||||
MAIN: boot
|
|
@ -0,0 +1,117 @@
|
|||
|
||||
Raptor Linux
|
||||
|
||||
*** Introduction ***
|
||||
|
||||
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.
|
||||
|
||||
*** Install ***
|
||||
|
||||
( scratchpad ) USE: raptor
|
||||
( scratchpad ) save
|
||||
|
||||
# mv -v /sbin/{init,init.orig}
|
||||
|
||||
# cp -v /scratch/factor/factor /sbin/init
|
||||
|
||||
# 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
|
||||
networking.
|
||||
|
||||
# emacs /etc/raptor/config.factor
|
||||
|
||||
(change the settings accordingly)
|
||||
|
||||
The udev system has a hook to bring up ethernet interfaces when they
|
||||
are detected. Let's remove this hook since we'll be bringing up the
|
||||
interface. Actually, we'll move it, not delete it.
|
||||
|
||||
# mv -v /etc/udev/rules.d/85-ifupdown.rules /root
|
||||
|
||||
*** DHCP networking ***
|
||||
|
||||
If you're using dhcp then we'll fall back on what Ubuntu offers. In
|
||||
your config.factor change the line :
|
||||
|
||||
start-networking
|
||||
|
||||
to
|
||||
|
||||
"loopback" start-service
|
||||
"networking" start-service
|
||||
|
||||
Add these to your reboot-hook and shutdown-hook :
|
||||
|
||||
"loopback" stop-service
|
||||
"networking" stop-service
|
||||
|
||||
*** Editing the hooks ***
|
||||
|
||||
The items in boot-hook correspond to the things in '/etc/rcS.d' and
|
||||
'/etc/rc2.d'. Feel free to add and remove items from that hook. For
|
||||
example, I removed the printer services. I also removed other things
|
||||
that I didn't feel were necessary on my system.
|
||||
|
||||
*** Grub ***
|
||||
|
||||
Edit your '/boot/grub/menu.lst'. Basically, copy and paste your
|
||||
current good entry. My default entry is this:
|
||||
|
||||
title Ubuntu, kernel 2.6.15-28-686
|
||||
root (hd0,0)
|
||||
kernel /boot/vmlinuz-2.6.15-28-686 root=/dev/hda1 ro quiet splash
|
||||
initrd /boot/initrd.img-2.6.15-28-686
|
||||
savedefault
|
||||
boot
|
||||
|
||||
I pasted a copy above it and edited it to look like this:
|
||||
|
||||
title Raptor, kernel 2.6.15-28-686
|
||||
root (hd0,0)
|
||||
kernel /boot/vmlinuz-2.6.15-28-686 root=/dev/hda1 ro quiet -run=ubuntu.dapper.boot
|
||||
initrd /boot/initrd.img-2.6.15-28-686
|
||||
savedefault
|
||||
boot
|
||||
|
||||
* Note that I removed the 'splash' kernel option
|
||||
|
||||
* Note the '-run=ubuntu.dapper.boot' option. Unfortunately, this isn't
|
||||
working yet...
|
||||
|
||||
*** Boot ***
|
||||
|
||||
Reboot or turn on your computer. Eventually, hopefully, you'll be at a
|
||||
Factor prompt. Boot your system:
|
||||
|
||||
( scratchpad ) boot
|
||||
|
||||
You'll probably be prompted to select a vocab. Select 'raptor'.
|
||||
|
||||
*** Now what ***
|
||||
|
||||
The virtual consoles are allocated like so:
|
||||
|
||||
1 - Main listener console
|
||||
2 - listener
|
||||
3 - listener
|
||||
4 - listener
|
||||
5 - getty
|
||||
6 - getty
|
||||
|
||||
So you're next step might be to alt-f5, login, and run startx.
|
||||
|
||||
*** Join the fun ***
|
||||
|
||||
Take a loot at what happens during run levels S and 2. Implement a
|
||||
Factor version of something. Let me know about it.
|
||||
|
|
@ -27,5 +27,15 @@ IN: unix.process
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: with-fork ( child parent -- pid ) fork [ zero? -rot if ] keep ; inline
|
||||
: with-fork ( child parent -- ) fork dup zero? -roll swap curry if ; inline
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! This is kludgy. We need a better implementation.
|
||||
|
||||
USE: threads
|
||||
|
||||
: wait-for-pid ( pid -- )
|
||||
dup "int" <c-object> WNOHANG waitpid
|
||||
0 = [ 100 sleep wait-for-pid ] [ drop ] if ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue