Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
299dca3200
|
|
@ -54,8 +54,8 @@ M: unix-io run-process* ( desc -- )
|
||||||
setup-stdio-pipe
|
setup-stdio-pipe
|
||||||
(spawn-process)
|
(spawn-process)
|
||||||
] [
|
] [
|
||||||
2dup second close first close
|
-rot 2dup second close first close
|
||||||
] with-fork >r first swap second r> ;
|
] with-fork first swap second rot ;
|
||||||
|
|
||||||
TUPLE: pipe-stream pid ;
|
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