#! /usr/local/bin/forth -q
\ program to run traceroute and send result back as an html file
\ (c) Copyright 1996 Taygeta Scientific Inc. Permission is granted by the
\ author to use this software for any application provided this
\ copyright notice is preserved.
\ rcsid: @(#)trace 1.1 13:38:11 8/1/96 EFC
\ ============= A String pointer data structure =============================
: string: \ build a counted string
CREATE
0 , \ POINTER to the data
0 , \ the count
DOES>
DUP @ SWAP CELL+ @
;
string: command
string: command-line
string: raddr
string: rhost
0 VALUE seq-file
0 VALUE log-file
0 VALUE seq-no
CREATE NEW-LINE-CHARS 2 ALLOT
10 NEW-LINE-CHARS C!
\ 13 NEW-LINE-CHARS 1+ C!
create out-buf 32 ALLOT
: $! ( addr count 'str -- ) \ store a string
>BODY
SWAP OVER CELL+ !
!
;
: $len ( addr count -- count )
SWAP DROP
;
: $copy ( addr count 'str -- )
HERE 2 PICK ROT $! \ store string pointer to HERE
HERE SWAP DUP ALLOT
CMOVE
;
: $cat ( addr1 count1 addr2 count2 -- addr count )
2 PICK OVER + DUP >R
HERE >R
ALLOT
2SWAP
R@ SWAP DUP >R CMOVE \ move first string
R> R@ +
SWAP CMOVE \ move the second string
R> R>
;
: atol ( addr count -- d )
>R
0. ROT
R>
>NUMBER
2DROP
;
: atoi ( addr count -- n )
atol DROP
;
: move-chars ( dest src count -- dest count )
>R OVER R@ CMOVE R>
;
: itoa ( n -- addr count ) \ (signed) int to counted string
out-buf aligned SWAP
DUP >R ABS S>D
<# #S R> SIGN #>
move-chars
;
\ ANS Brute force OPEN-APPEND, depending upon what is under the hood, there may
\ be more efficient definitions
: OPEN-APPEND R/W OPEN-FILE
DUP 0= IF OVER FILE-SIZE
0= IF 3 PICK REPOSITION-FILE DROP THEN
THEN
;
: nack ( -- )
." Traceroute to Taygeta NOT OK "
." " CR
." SORRY!
" CR
." Sorry, I can't figure out where you are so I can't "
." trace how long it takes to get a packet to me "
."
" CR
;
: header ( -- )
." " CR
." Traceroute to Taygeta" CR
." Traceroute from Taygeta to you
" CR
."
" CR
;
: trailer ( -- )
."
" CR
." You are user number " seq-no . ." of this page
" CR
." Another CGI script written in"
." Forth !
" CR
." "
." ![[CHAR]]( [CHAR] )
"
." Back to Skips Home page. " CR
."
" CR
;
: sig
."
" CR
." Everett F. Carter Jr. -- skip@taygeta.com" CR
." " CR
." " CR
;
: write-env ( -- len )
S" SERVER_PROTOCOL" getenv
DUP 0= IF 2DROP S" HTTP/1.0" THEN TYPE
." 200 OK" CR
." MIME-Version: 1.0" CR
S" SERVER_SOFTWARE" getenv
DUP 0 > IF TYPE CR ELSE 2DROP THEN
." Content-Type: text/html" CR
\ ." Content-Encoding: HTML" CR
\ ." Content-Transfer-Encoding: HTML" CR
CR
S" CONTENT_LENGTH" getenv
DUP IF atoi ELSE 2DROP 0 THEN
;
: newline ( fileid -- flag )
NEW-LINE-CHARS 1 ROT WRITE-FILE
;
S" REMOTE_ADDR" getenv ' raddr $!
S" /usr/bin/traceroute " ' command $!
S" REMOTE_HOST" getenv ' rhost $!
: report-log ( -- )
log-file newline DROP
PAD 24 timestamp log-file WRITE-FILE DROP
S" Sequence number is: " log-file WRITE-FILE DROP
itoa log-file WRITE-FILE DROP
log-file newline DROP
rhost log-file write-file DROP
S" " log-file write-file DROP
raddr log-file write-file DROP
log-file newline DROP
;
: update_sequence_number ( -- old_no )
S" /usr/local/etc/logs/trace.seq"
R/W OPEN-FILE ABORT" Unable to open sequence file "
TO seq-file
\ get the current sequence number
PAD 16 seq-file READ-LINE ABORT" file read error "
DROP
PAD SWAP atoi
\ increment the number and store it away
DUP 1+
0. seq-file REPOSITION-FILE DROP
itoa seq-file WRITE-LINE DROP
seq-file CLOSE-FILE DROP
;
: trace ( -- )
command raddr $cat ['] command-line $!
S" /usr/local/etc/logs/trace.log"
OPEN-APPEND ABORT" Unable to open log file "
TO log-file
update_sequence_number DUP TO seq-no
report-log
write-env DROP
raddr $len IF
header
." " CR
command-line system
." " CR
ELSE
nack
THEN
trailer
sig
log-file CLOSE-FILE DROP
;
trace bye