The EtherSmart Wildcard User Guide

Appendix D: Forth Demo Program

Listing 1‑20 Ether_Demo.4th program listing.

\ this demonstration code is provided in source form.

\ Top level functions:

\ Web_Demo ( -- ) \ no input parameters; runs web pages, enables email, tunneling

\ Ether_Monitor_Demo ( modulenum -- ) \ runs ethernet interactive monitor;see comments

\ these can be called interactively (from QEDTerminal) after Web_Demo is invoked:

\ Tunnel_Test \ no input parameters, echoes data from Putty connection

\ Email_Test \ no input parameters, returns error code. Sends an email;

\ Note: YOU MUST EDIT THIS FUNCTION’s HARD-CODED IP ADDRESS and

\ the hostname_str, sender_str, and recipient_str BEFORE CALLING!

\ ******************* SET MEMORY MAP HERE (IF IT’S NOT ALREADY SET) ****************

\ ************** USEFUL CONSTANTS **************

HEX

400 CONSTANT TASK_SIZE \ 0x400 = decimal 1024 = 1Kbyte = task size

0D CONSTANT CR_ASCII \ ascii carriage return

0D0A CONSTANT CRLF_ASCII \ this is the standard eol sequence for tcp/ip services.

DECIMAL \ rest of file is in decimal base

25 CONSTANT SMTP_PORT \ email Simple Mail Transfer Protocol destination port

\ *************** IMPORTANT: SET MODULENUM TO MATCH HARDWARE JUMPERS ******************

FIND E_MODULENUM \ don’t redefine if already defined in a prior file

IFTRUE

XDROP

OTHERWISE

4 CONSTANT E_MODULENUM \ ******** SET THIS TO MATCH HARDWARE JUMPERS J1 AND J2! *****

ENDIFTRUE

\ This specifies the modulenum for the high level functions in this file

\ except for Ether_Monitor_Demo (see its comments).

\ If EtherSmart is installed on module bus 0, E_MODULENUM = 0, 1, 2, or 3

\ If EtherSmart is installed on module bus 1, E_MODULENUM = 4, 5, 6, or 7

\ That is, the bus specifies the top bit of a 3-bit modulenum,

\ and [J2, J1] specifies the remaining 2 bits of the modulenum.

\ Example: On module bus 0, if neither jumper cap is installed: E_MODULENUM = 0

\ Example: On module bus 0, if both jumper caps are installed: E_MODULENUM = 3

\ Example: On module bus 1, if J2 is installed but J1 is not: E_MODULENUM = 6

\ ************** SETUP ETHERNET TASK TO RUN WEB AND TUNNELING SERVICES **************

TASK_SIZE V.INSTANCE: ether_control_task \ 1 Kbyte per task area

: Ether_Task_Setup_Default ( -- )

\ performs full initialization of the ether_info struct and mailboxes for the

\ specified modulenum, and

\ builds and activates an ethernet control task to service the xport

\ (STATUS) NEXT.TASK ! \ empty the task loop; comment out if other tasks are allowed

ether_control_task DROP E_MODULENUM ( taskbase_addr\modulenum -- )

Ether_Task_Setup ( -- )

;

\ ***************** INTERACTIVE CONFIGURATION AND REPORTING ************

: Ether_Set_Defaults ( -- error )

\ call this AFTER calling Web_Demo or Ether_Task_Setup_Default !

\ sets mosaic factory defaults; returns error code

\ sets local IP and gateway to 0.0.0.0 = unassigned, so IP address

\ gets assigned via DHCP (Dynamic Host Configuration Protocol) by the LAN’s gateway.

\ see user guide for more information.

CR .” Setting defaults...” CR

E_MODULENUM Ether_XPort_Defaults

E_MODULENUM Ether_Await_Response DROP \ error code is in lsword

;

: Ether_Set_Local_IP ( my_ip1\my_ip2\my\my_ip4 -- )

\ call this AFTER calling Web_Demo or Ether_Task_Setup_Default !

\ sets the IP address of the EtherSmart Wildcard specified by E_MODULENUM as:

\ ip1.ip2.ip3.ip4

\ For example, to set the IP address to 10.0.1.22, pass to this function the parameters:

\ 10 0 1 22

\ returns error code

\ NOTES: type DECIMAL at the monitor before invoking this function interactively!

CR .” Setting local IP address...” CR

E_MODULENUM Ether_Local_IP ( -- )

E_MODULENUM Ether_XPort_Update

E_MODULENUM Ether_Await_Response DROP \ error code is in lsword

;

: Ether_IP_Report ( -- )

\ call this AFTER calling Web_Demo or Ether_Task_Setup_Default !

\ takes 7 seconds to execute, so be patient.

\ Report is of the form:

\ IP 010.000.001.019 GW 010.000.001.022 Mask 255.255.255.000

\ which summarizes the IP address, gateway address, and netmask, respectively.

E_MODULENUM Ether_IP_Info_Report

;

: Ether_Ping ( my_ip1\my_ip2\my\my_ip4 -- )

\ call this AFTER calling Web_Demo or Ether_Task_Setup_Default !

\ on error, prints “ Couldn’t enter monitor mode!” or “ No response from remote”.

\ takes thirteen seconds to execute, so be patient.

\ Report is of the form (summarizes response time from specified remote host):

\ Seq 001 time 10ms

\ Seq 002 time 10ms

\ Seq 003 time 10ms

\ Seq 004 time 10ms

\ Seq 005 time 10ms

\ Seq 006 time 10ms

\ NOTES: type DECIMAL at the monitor before invoking this function interactively!

E_MODULENUM Ether_Ping_Report

;

\ ***************** REVECTORED SERIAL VIA ETHERNET ************

\ simplest approach:

\ simply store the correct modulenum into the global var named ether_revector_module,

\ then call Ether_Serial_Revector

\ This will run the default (startup) task through the specified ethersmart wildcard.

\ Use Putty “rlogin” to connect to the local port (typically = 80)

\ at the specified local IP address, and you’re talking to the QED monitor via ethernet.

\ To revert to standard serial operation via QED Term, type COLD to revert to standard

\ serial, then from QEDTerm type RESTORE to bring back access to all compiled routines,

\ then continue communications using QEDTerm.

\ If you want to maintain serial communications via QEDTerm with the default task

\ while running a separate task with I/O revectored via the Ethersmart Wildcard,

\ then build and activate a task using Ether_Monitor as the activation routine.

\ Use Putty “rlogin” to connect to the local port (typically = 80)

\ at the specified local IP address, and you’re talking to the task via ethernet.

TASK_SIZE V.INSTANCE: ether_montask \ 1 Kbyte per task area

: Ether_Monitor_Demo ( modulenum -- )

\ builds and activates a monitor task for the specified module.

\ this function expects the modulenum as an input parameter so that

\ you can run 2 installed Ethersmart wildcards at once:

\ one wildcard can run the standard services (web, email, tunneling)

\ while the other one (running Ether_Monitor_Demo) is used to download code

\ and control program development and debugging.

\ To do this, first call Web_Demo (which runs services on the E_MODULENUM wildcard),

\ then call this Ether_Monitor_Demo function with a different modulenum.

1 NEEDED ( modulenum--) \ make sure the input param is present

ether_revector_module ! ( -- )

RELEASE.ALWAYS SERIAL.ACCESS ! \ ensure lots of PAUSEs in Forth task

\ (STATUS) NEXT.TASK ! \ empty the task loop; comment out if other tasks are allowed

0\0 0\0 0\0 ether_montask BUILD.STANDARD.TASK

CFA.FOR Ether_Monitor ether_montask ACTIVATE

;

\ ******************* SERIAL TUNNELING TEST **************

: Tunnel_Test ( -- )

\ call after doing Ether_Task_Setup_Default

\ Waits for incoming non-web connection on this module’s IP address on port 80

\ (the default local port), and examines the linefeed-delimited first line to see

\ if it starts with GET; if not, it accepts it as a passive non-web connection.

\ So: don’t type GET as the first characters of the connection (you’ll confuse the system).

\ The easiest way to open a connection is via Putty, using the “raw” mode.

\ Note: If you use “telnet” mode, you’ll see some garbage characters in the first line;

\ these are control bytes with the msbit set that are accepted by the connection manager.

E_MODULENUM

20000 \ use a 20 second timeout for testing; sets delay til function exit

0 0 0 \ initial values for &error &num_received &numlines locals

LOCALS{ &error &num_received &numlines &timeout &module }

CR .” Waiting for connection (type a carriage return from QEDTerm to abort)...”

CR .” (Suggestion: To connect, use Putty in ‘raw’ mode, specify IP address, port 80,”

CR .” and type a carriage return once the session window opens.”

BEGIN

PAUSE.ON.KEY \ abort on CR, pause/resume on other keys

&module Ether_Check_Response 2DROP ( -- ) \ keep mailbox clean, ignore messages

&module Ether_Passive_Non_Web_Connection ( tunneling_connection? -- )

UNTIL

CR .” An incoming connection has been accepted;”

CR .” each incoming line will be printed to the serial terminal, and a”

CR .” response prompt will be sent to the ethernet terminal.”

CR .” To exit this routine, wait 20 seconds without typing a line.”

\ the first line is in HTTP_Inbuf (because webserver had to check its identity)...

&module HTTP_Inbuf LCOUNT TYPE \ type first line & cr to local serial terminal

BEGIN \ loop and echo additional lines til timeout...

&module Ether_Inbuf &module Ether_Inbufsize CR_ASCII TRUE TRUE &timeout &module

( xlbuf\maxchars\eol\discard.alt.eol?\no.msbitset?\timeout_msec\module--)

Ether_Get_Line ( -- ) \ get 1 line into lcounted ether_inbuf

&module Ether_Await_Response ( numbytes_rcvd\cmd&module-- )

DROP TO &num_received

&module Ether_Inbuf LCOUNT TYPE \ type line & cr to local serial terminal

&num_received

IF “ Line was received>“ COUNT &timeout &module

( xaddr\count\timeout_msec\module_number -- )

Ether_Send_Buffer ( -- ) \ send prompt

&module Ether_Await_Response ( numbytes_sent\cmd&module--) \ wait for result

2DROP

&numlines 1+ TO &numlines ( -- ) \ bump numlines

ENDIF

&num_received 0= ( done? -- )

UNTIL \ until no chars rcvd due to timeout or connection close

&module Ether_Disconnect_Flush ( -- ) \ clean up

&module Ether_Await_Response 2DROP ( -- ) \ synchronize to result mailbox before exit

CR .” Connection terminated.” CR

;

\ ********************* EMAIL TEST ***************************

\ Use CREATE for relocatable strings. CFA.FOR HOSTNAME$ returns string address.

CREATE hostname_str “ xport.yourdomain.com” XDROP \ drop string xaddr

CREATE sender_str “ niceguy@yourdomain.com” XDROP \ drop string xaddr

CREATE recipient_str “ notso_niceguy@yourdomain.com” XDROP \ drop string xaddr

CREATE email_body_str \ use cfa.for email_body_str to obtain the longbuffer xaddress

DP -1 CRLF_ASCII ASCII } ( xpointer.to.result.area\max.chars\EOL\delim--)

LPARSE

Subject: EtherSmart Email Test

This is a test email from the EtherSmart Wildcard.

Emails can of course have multiple lines... }

XDROP \ drop string xaddr; use cfa.for <name>

: Email_Test ( -- error )

\ smtp email test routine.

\ Note: YOU MUST EDIT THIS FUNCTION’s HARD-CODED IP ADDRESS

\ AND the hostname_str, sender_str, and recipient_str BEFORE CALLING!

\ Otherwise, it will not work on your system.

\ error= 0 on success, or error_no_response = 0x10, or the smtp 3-digit decimal error code

E_MODULENUM

LOCALS{ &module }

CFA.FOR email_body_str LCOUNT ( xbody_string\cnt--) \ subject plus 2-line email

CFA.FOR hostname_str COUNT

CFA.FOR sender_str COUNT

CFA.FOR recipient_str COUNT

&module Ether_Inbuf \ scratchpad xbuffer

10 0 1 1 \ IMPORTANT: ENTER YOUR GATEWAY’S IP ADDRESS HERE!

SMTP_PORT \ port 25 = standard mailserver destination port

10000 \ use a 10 second timeout (10,000 msec) for testing

&module

( email_body_xaddr\ecnt\hostname_xaddr\hcnt\sender_xaddr\scnt\rcvr_xaddr\rcnt

\ \scratchpad_xbuf\dest_ip1\ip2\ip3\ip4\dest_port\timeout_msec\modulenum -- )

Ether_Send_Email ( -- )

&module Ether_Await_Response ( -- d.mailbox_contents ) \ error code is in lsword

DROP ( -- error )

;

\ *********************** WEBSERVER DEMO (Ethersmart Web Pages) ***************

\ before sending this file (in the loader that includes this file),

\ include the s-record version of the html pages and the image(s) as:

\ #include “Resources\image_data.txt”

\ see the demo includer file

\ before sending this file (in the loader that includes this file),

\ include the header file that defines the base xaddress and 32-bit size for each resource:

\ #include “Resources\image_headers.4th”

DECIMAL \ confirm compilation base in case the include files changed them

\ each file name is concatenated via the _ character with its extension,

\ and 32-bit constants are created with the _XADDR and _SIZE endings.

\ NOTE: Make each filename C-compatible, using only letters, _ (underscore), and

\ non-leading numerals in the filename.

\ In this demo program the resources comprise the image file mosaic_logo.png,

\ and the html files form_page.html, home_body.html, and opera_config.html.

\ The following 32-bit constants are declared in the image_headers.txt file:

\ FORM_PAGE_HTML_XADDR

\ FORM_PAGE_HTML_SIZE

\ HOME_BODY_HTML_XADDR

\ HOME_BODY_HTML_SIZE

\ MOSAIC_LOGO_PNG_XADDR

\ MOSAIC_LOGO_PNG_SIZE

\ OPERA_CONFIG_HTML_XADDR

\ OPERA_CONFIG_HTML_SIZE

\ note: in form_page_str, we mark one of the radio buttons as checked; otherwise,

\ the browser can skip the field entirely, then we would have to match the fieldnames!

CREATE form_response_str \ cfa.for form_response_str to obtain the longbuffer xaddress

DP -1 CRLF_ASCII ASCII ` ( xpointer.to.result.area\max.chars\EOL\delim--)

LPARSE

<html><head><title>Form Response</title></head><body><H3>Thanks for your response!</H3><p>

<p>It must be great to be a `

XDROP ( -- ) \ drop x$addr, use cfa.for to get relocatable runtime xl$addr

: Home_Page ( modulenum -- )

\ this is the handler function for the /index.html and the / URLs.

\ sends the http header with dynamic (because of changing time stamp) text/html

\ content type, followed by home_body_str text and the elapsed seconds since the

\ system was initialized.

BASE @ DECIMAL \ display to web page in decimal base

LOCALS{ &prior_base &module }

&module HTTP_Outbuf &module HTTP_Outbufsize HTTP_Put_Header \ http header->outbuf

&module HTTP_Outbuf &module HTTP_Outbufsize

-1 HTTP_TEXT_HTML_CONTENT ( xlbuf\maxbufsize\dynamic?\content--)

HTTP_Put_Content_Type \ dynamic text/html content ->outbuf;header is done

&module HTTP_Outbuf &module ( xbuf\module--)

HTTP_Send_LBuffer DROP ( -- ) \ send out header, drop #bytes_sent

HOME_BODY_HTML_XADDR HOME_BODY_HTML_SIZE D>S &module ( xlstring\count\module_num--)

HTTP_Send_Buffer DROP ( -- ) \ send direct from str buf, drop #bytes_sent

&module HTTP_Outbuf OFF \ reset lcount to start fresh in buffer

READ.ELAPSED.SECONDS ROT DROP ( ud#sec-- ) \ drop #msec!

<# #S #> ( xaddr\cnt -- ) \ convert time to ascii string

&module ( xstring_to_add\cnt_to_add\module--)

HTTP_Outbuf_Cat ( -- ) \ add line & crlf to longstring, update lcnt

“ seconds since system initialization.</body></html>“

COUNT &module ( xstring_to_add\cnt_to_add\module_num--)

HTTP_Outbuf_Cat ( -- ) \ add line & crlf to longstring, update lcnt

&module HTTP_Outbuf &module ( xbuf\module--)

HTTP_Send_LBuffer DROP ( -- ) \ send final line, drop #bytes_sent

&prior_base BASE ! ( -- ) \ restore prior numeric base

;

: Opera_Config_Page ( modulenum -- )

\ this is the handler function for the /opera_configuration.html URL.

\ sends the http header with static text/html content type,

\ followed by opera_config_str text

LOCALS{ &module }

&module HTTP_Outbuf &module HTTP_Outbufsize HTTP_Put_Header \ http header->outbuf

&module HTTP_Outbuf &module HTTP_Outbufsize

0 HTTP_TEXT_HTML_CONTENT ( output_xlbuf\max_bufsize\dynamic?\content_id -- )

HTTP_Put_Content_Type \ static text/html content ->outbuf;header is done

&module HTTP_Outbuf &module ( xbuf\module--)

HTTP_Send_LBuffer DROP ( -- ) \ send out header, drop #bytes_sent

OPERA_CONFIG_HTML_XADDR OPERA_CONFIG_HTML_SIZE D>S &module ( xlstring\count\modulenum--)

HTTP_Send_Buffer DROP ( -- ) \ send direct from str buf, drop #bytes_sent

;

: Form_Entry_Page ( modulenum -- )

\ responds to url= /form_entry.html

\ places FORM_TEXT into the buffer as a longstring after the http header.

\ we send directly from compiled string in flash to avoid copy into ether_out buffer;

\ this method is ideal for serving static text.

LOCALS{ &module }

&module HTTP_Outbuf &module HTTP_Outbufsize 3DUP

HTTP_Put_Header ( xbuffer\bufsize -- )

0 HTTP_TEXT_HTML_CONTENT ( output_xlbuf\max_bufsize\dynamic?\content_id -- )

HTTP_Put_Content_Type ( -- ) \ static text/html content

&module HTTP_Outbuf &module

HTTP_Send_LBuffer DROP ( -- ) \ drop #bytes_sent; header has been sent

FORM_PAGE_HTML_XADDR FORM_PAGE_HTML_SIZE D>S &module ( xbuf\count\module--)

HTTP_Send_Buffer DROP ( -- ) \ drop #bytes_sent

;

: Form_Response_Page ( modulenum -- )

\ this is the handler function that responds to url= /form_response.cgi

\ incoming request from browser looks like this:

\ GET /form_response.cgi?classification=<man/woman/child>&name_id=<namestring>

\ &color=<red/blue/yellow/green>

\ We respond:

\ It must be great to be a <man/woman/child/person> with a name like <namestring/yours>.

\ It’s good to hear that <red/blue/yellow/green/rainbow> is your favorite color.

DUP HTTP_Outbuf

LOCALS{ x&lstring_buf &module | x&next_value_ptr &next_value_count }

x&lstring_buf &module HTTP_Outbufsize DUP>R

HTTP_Put_Header ( -- )

x&lstring_buf R> 0 HTTP_TEXT_HTML_CONTENT ( xlbuf\max_bufsize\dynamic?\content_id--)

HTTP_Put_Content_Type ( -- ) \ static text/html content

x&lstring_buf &module

HTTP_Send_LBuffer DROP ( -- ) \ header has been sent; drop #bytes_sent

CFA.FOR form_response_str &module ( xbuf\module--)

HTTP_Send_LBuffer DROP ( -- ) \ send static text, drop #bytes_sent

x&lstring_buf OFF \ reset lbuffer count

&module HTTP_Value_Ptr &module HTTP_Value_Count DUP 0= ( class_xaddr\cnt\null?--)

IF 3DROP “ person” COUNT ( xstring_to_add\cnt_to_add--) \ substitution

ENDIF

&module HTTP_Outbuf_Cat ( -- ) \ add line & crlf to longstring, update lcnt

“ with a name like “ COUNT &module HTTP_Outbuf_Cat ( -- ) \ add line, update lcnt

&module HTTP_To_Next_Field DROP ( -- ) \ go to name_id field, drop #chars_advanced

&module HTTP_Value_Ptr &module HTTP_Value_Count DUP ( nameID_xaddr\cnt\present?--)

&module HTTP_To_Next_Field DROP ( nameID_xaddr\cnt\present?--) \ go to color field

&module HTTP_Value_Ptr TO x&next_value_ptr \ get next field params before we unescape!

&module HTTP_Value_Count TO &next_value_count ( nameID_xaddr\cnt\present?--)

IF 3DUP HTTP_Plus_To_Space ( nameID_xaddr\cnt--) \ get rid of +’s in name text

>R XDUP R> ( xaddr\xaddr\cnt -- )

HTTP_Unescape ( xaddr\revised_cnt -- ) \ get rid of special chars

ELSE 3DROP “ yours” COUNT ( xstring_to_add\cnt_to_add--) \ “name like yours”

ENDIF

&module HTTP_Outbuf_Cat ( -- ) \ add line & crlf to longstring, update lcnt

“ . It’s good to hear that “ COUNT ( xaddr\cnt-- )

&module HTTP_Outbuf_Cat ( -- ) \ add line & crlf to longstring, update lcnt

x&next_value_ptr &next_value_count DUP 0= ( color_xaddr\cnt\empty--)

IF 3DROP “ rainbow” COUNT ( xstring_to_add\cnt_to_add--) \ substitution

ENDIF

&module HTTP_Outbuf_Cat ( -- ) \ add line & crlf to longstring, update lcnt

“ is your favorite color!</body></html>“ COUNT

&module HTTP_Outbuf_Cat ( -- ) \ add line & crlf to longstring, update lcnt

x&lstring_buf &module

HTTP_Send_LBuffer DROP ( -- ) \ page has been sent; drop #bytes_sent

;

: Logo_Response_Page ( module -- )

\ this is the handler function that responds to url= /logo_response.png

\ assumes that logo.s2 has been loaded into memory. serves it as static image.

DUP HTTP_Outbuf

LOCALS{ x&lstring_buf &module }

x&lstring_buf &module HTTP_Outbufsize DUP>R

HTTP_Put_Header ( -- )

x&lstring_buf R> 0 HTTP_IMAGE_PNG_CONTENT ( xlbuf\max_bufsize\dynamic?\content_id--)

HTTP_Put_Content_Type ( -- ) \ static png image content

x&lstring_buf LCOUNT ( xaddr_buf1\count1--)

MOSAIC_LOGO_PNG_XADDR MOSAIC_LOGO_PNG_SIZE D>S

&module ( xbuf1\cnt1\xbuf2\count2\module--)

HTTP_Send_2Buffers DROP ( -- ) \ send header&image, drop numbytes_sent

;

: Web_Handler_Installation ( modulenum -- error? )

\ call this after Ether_Task_Setup_Default

\ point browser to raw ip or to ip/index.html to see the home web page.

\ urls are case sensitive. any other url’s serve out: page not found.

\ returns nonzero error if too many handlers were added

\ (limited by AUTOSERVE_DEFAULT_ROWS passed to ether_init)

0 LOCALS{ &error &module }

“ /” COUNT CFA.FOR Home_Page &module ( url_xaddr\count\handler_xcfa\mod--)