;----------------------------------------------------------------------------
;File name:	T_SERVER.S			Revision date:	1998.12.13
;Creator:	Ulf Ronald Andersson		Creation date:	1997.07.31
;(c)1998 by:	Ulf Ronald Andersson		All rights reserved
;Feedback to:	dlanor@oden.se
;----------------------------------------------------------------------------
	include	RA_TOS.I
	include	RA_JAR.I
;
	include	sting\NETD.I
	include	sting\LAYER.I
	include	sting\TRANSPRT.I
	include	sting\NET_TCON.I
	include	sting\DOMAIN.I
;----------------------------------------------------------------------------
	output	.PRG
;----------------------------------------------------------------------------
M_YEAR	=	1998
M_MONTH	=	12
M_DAY	=	13
;
M_TITLE		MACRO
		dc.b	'TIME+DAYTIME server'
		ENDM
M_VERSION	MACRO
		dc.b	'01.08'
		ENDM
M_AUTHOR	MACRO
		dc.b	'Ronald Andersson'
		ENDM
;----------------------------------------------------------------------------
ZERO_IP		=	0	;local IP code for listening connections
TOS_NORMAL	=	0	;normal TCP TOS code for TCP_open
;----------------------------------------------------------------------------
;Start of:	server program
;----------------------------------------------------------------------------
	SECTION	TEXT
;----------------------------------------------------------------------------
text_start:
basepage	=	(text_start-$100)
my_SRV		=	basepage	;ND_SRV_base
;----------------------------------------------------------------------------
my_LongJump:
start:
	jmp	(start_1).l		;ND_SRV_jump
;----------------------------------------------------------------------------
;Start of:	Resident server data (starting with tail of NetD_SRV struct)
;----------------------------------------------------------------------------
my_magic:
	dc.l	ND_XB_ID	;ND_SRV_magic	;Must equal ND_XB_ID
	dc.l	'_SRV'		;ND_SRV_xmagic	;Must equal '_SRV'
	dc.l	REF_IF_VER	;ND_SRV_if_ver	;NetD interface version of server
	dc.w	((M_YEAR-1980)<<9)|(M_MONTH<<5)|M_DAY	;uint16 ND_SRV_date
	dc.l	my_version_s	;ND_SRV_version	;server version string in "xx.yy" format
	dc.l	my_author_s	;char_p ND_SRV_author	;-> name of author of server
;-------
	dc.l	my_title_s	;char_p ND_SRV_name	;name of the server
;-------
	dc.l	0		;struc_p ND_SRV_next	    ;-> next server struct or is NULL
	dc.l	my_SRV_connect	;func_p  ND_SRV_connect   ;-> server function used at connect
	dc.l	my_SRV_traffic	;func_p  ND_SRV_traffic   ;-> server function for fluent traffic
	dc.l	my_SRV_warning	;func_p  ND_SRV_warning ;-> server function used at NetD APP termination
	dc.l	0		;struc_p ND_SRV_listen_q  ;-> queue for listening connections
	dc.l	0		;struc_p ND_SRV_turnon_q  ;-> queue for connections turning active
	dc.l	0		;struc_p ND_SRV_active_q  ;-> queue for active connections
	dc.w	0		;uint16  ND_SRV_flags     ;control flags
;----------------------------------------------------------------------------
sting_drivers:	dc.l	0	;DRV_LIST	*sting_drivers;
tpl:		dc.l	0	;TPL		*tpl;
stx:		dc.l	0	;STX		*stx;
;----------------------------------------------------------------------------
my_title_s:
	M_TITLE
	dc.b	NUL
my_version_s:
	M_VERSION
	dc.b	NUL
my_author_s:
	M_AUTHOR
	dc.b	NUL
	EVEN
;----------------------------------------------------------------------------
DAY_TIME_PORT	equ	13
NET_TIME_PORT	equ	37
BUF_SIZE	equ	500
;----------------------------------------------------------------------------
;Enter program constant definitions below:
;
NetD_STX_p:	dc.l	0
weekday_spt:	dc.l	sunday_s,monday_s,tuesday_s,wednesday_s
		dc.l	thursday_s,friday_s,saturday_s,sunday_s
;
month_spt:	dc.l	january_s,february_s,march_s,april_s
		dc.l	may_s,june_s,july_s,august_s
		dc.l	september_s,october_s,november_s,december_s
;
sunday_s:	dc.b	'Sun',NUL
monday_s:	dc.b	'Mon',NUL
tuesday_s:	dc.b	'Tue',NUL
wednesday_s:	dc.b	'Wed',NUL
thursday_s:	dc.b	'Thu',NUL
friday_s:	dc.b	'Fri',NUL
saturday_s:	dc.b	'Sat',NUL
;
january_s:	dc.b	"Jan",NUL
february_s:	dc.b	"Feb",NUL
march_s:	dc.b	"Mar",NUL
april_s:	dc.b	"Apr",NUL
may_s:		dc.b	"May",NUL
june_s:		dc.b	"Jun",NUL
july_s:		dc.b	"Jul",NUL
august_s:	dc.b	"Aug",NUL
september_s:	dc.b	"Sep",NUL
october_s:	dc.b	"Oct",NUL
november_s:	dc.b	"Nov",NUL
december_s:	dc.b	"Dec",NUL
;
GMT_tail_s:	dc.b	' @ GMT',NUL
		EVEN
;----------------------------------------------------------------------------
;Enter program variable definitions below:
;
tcon_data:	ds.b	sizeof_tcon
buffer:		ds.l	BUF_SIZE
;----------------------------------------------------------------------------
;End of:	Resident server data
;----------------------------------------------------------------------------
;Start of:	Main server functions
;----------------------------------------------------------------------------
;Start of:	my_SRV_connect
;----------------------------------------------------------------------------
;int16	my_SRV_connect (NetD_APP *NetD_APP_p, NetD_CON *new_con_p);
;
my_SRV_connect:
	lv_init		sp		;use sp to index args & locals
	lv_arg.l	NetD_APP_p	;-> NetD_APP struct
	lv_arg.l	new_con_p	;-> newly activated NetD_CON struct
;-------
	TIMER_now			;get current time
	move.l	new_con_p(sp),a0	;a0 -> NetD_CON
	move.l	d0,ND_CON_pad+0(a0)	;store current time as connection time
	move.l	d0,ND_CON_pad+4(a0)	;store current time as invalid send time
	moveq	#E_NORMAL,d0		;flag acceptance of connection
	lv_exit	sp			;end scope of sp for args & locals
	rts				;return to caller (the NetD STX)
;----------------------------------------------------------------------------
;End of:	my_SRV_connect
;----------------------------------------------------------------------------
;Start of:	my_SRV_traffic
;----------------------------------------------------------------------------
;void my_SRV_traffic (NetD_APP *NetD_APP_p);
;
my_SRV_traffic:
	lv_init		a6		;use a6 to index args & locals
	lv_arg.l	NetD_APP_p	;-> NetD_APP struct
	movem.l		a2-a4,-(sp)	;push some registers
;-------
	move.l	NetD_STX_p(pc),a3	;a3 -> NetD_STX struct  (from cookie)
	move.l	ND_SRV_active_q+my_SRV(pc),a4	;a4 -> NetD_CON in active queue
	move.l	a4,d0			;d0 -> current NetD_CON for traffic
	ble	exit_traffic		;exit at end of queue
traffic_loop:
	move.l	ND_CON_next(a4),a2	;a2 -> next NetD_CON (for next loop)
	move	ND_CON_type(a4),d0	;TCP/UDP ?
	beq.s	send_traffic		;skip send delay if using UDP
;-------
	TIMER_elapsed	ND_CON_pad+0(a4)	;d0 = measured time since connection
;-------
	cmp.l	#25000,d0		;d0 >= 25 seconds ?
	bhs.s	kill_traffic		;kill connection on max timeout
	move.l	ND_CON_pad+0(a4),d0	;d0 = connection time
	cmp.l	ND_CON_pad+4(a4),d0	;d0 == send time ?  (send time invalid ?)
	bne.s	traffic_sent		;if not, skip sending now
test_traffic:
	TCP_wait_state	ND_CON_handle(a4),#TESTABLISH,!	;test state with minimum delay
;-------
	cmp	#E_CNTIMEOUT,d0		;timeout ?  (need to try later)
	beq.s	next_traffic		;if so, leave this traffic as-is for now
	tst	d0			;any error ?  (TESTABLISH state unreachable)
	bmi.s	kill_traffic		;if so, kill the connection
send_traffic:
	bsr	serve_time_con_a4	;send response to client
	TIMER_now			;get current time
	move.l	d0,ND_CON_pad+4(a4)	;save as valid send time
traffic_sent:
	move	ND_CON_type(a4),d0	;TCP/UDP ?
	beq.s	kill_traffic		;skip ACK delay if using UDP
;-------
	TIMER_elapsed	ND_CON_pad+4(a4)	;d0 = measured time since sending
;-------
	cmp.l	#10000,d0		;d0 >= 10 seconds ?
	bhs.s	kill_traffic		;if so, go kill the connection
;-------
	TCP_ack_wait	ND_CON_handle(a4),!	;test for ACKing with minimum delay
;-------
	cmp	#E_CNTIMEOUT,d0		;timeout ?  (we need to try later)
	beq.s	next_traffic		;if so, leave this traffic as-is for now
kill_traffic:
	pea	(a4)			;push -> NetD_CON to be killed
	pea	my_SRV(pc)		;push -> NetD_SRV of this server
	move.l	ND_kill_CON(a3),a0	;a0 -> ND_kill_CON function in NetD STX
	jsr	(a0)			;call ND_kill_CON function in NetD_STX
	addq	#8,sp			;clean stack
next_traffic:
	move.l	a2,a4			;a4 -> next NetD_CON in queue
	move.l	a2,d0			;test next NetD_CON
	bgt	traffic_loop		;loop unless at end of queue
exit_traffic:
	movem.l	(sp)+,a2-a4		;pull some registers
	lv_exit	a6			;end scope of a6 for args & locals
	rts				;return to caller (the NetD STX)
;----------------------------------------------------------------------------
;End of:	my_SRV_traffic
;----------------------------------------------------------------------------
;Start of:	my_SRV_warning
;----------------------------------------------------------------------------
;void my_SRV_warning (NetD_APP *NetD_APP_p);
;
my_SRV_warning:
	rts
;----------------------------------------------------------------------------
;End of:	my_SRV_warning
;----------------------------------------------------------------------------
;End of:	Main server functions
;----------------------------------------------------------------------------
;Start of:	Resident subroutines used by server
;----------------------------------------------------------------------------
man2ascii:
	movem.l		d1/a1-a2,-(sp)
;-------
	move		tcon_man_weekday(a0),d0	;d0 = weekday index (0==Sunday)
	and		#7,d0			;limit index
	asl		#2,d0			;scale to index pointer table
	lea		weekday_spt(pc),a2	;a2 -> table of string pointers
	move.l		(a2,d0),a2		;a2 -> weekday string
	strcpy		a2,a1			;add weekday string to buffer
;-------
	move.b		#' ',-1(a1)		;replace string terminator with space
	move		tcon_man_month(a0),d0	;d0 = month number as 1..12
	subq		#1,d0			;d0 = month index as 0..11
	asl		#2,d0			;scale to index pointer table
	lea		month_spt(pc),a2	;a2 -> table of string pointers
	move.l		(a2,d0),a2		;a2 -> month string
	strcpy		a2,a1			;add month string to buffer
;-------
	move.b		#' ',-1(a1)		;replace string terminator with space
	move		tcon_man_date(a0),d0	;d0 = day_in_month as 1..31
	bsr		word2ascii2		;add 2 day_in_month chars to buffer
;-------
	move.b		#' ',(a1)+		;add a space to buffer
	move		tcon_man_hour(a0),d0
	bsr		word2ascii2
	move.b		#':',(a1)+
	move		tcon_man_minute(a0),d0
	bsr		word2ascii2
	move.b		#':',(a1)+
	move		tcon_man_second(a0),d0
	bsr		word2ascii2
;-------
	move.b		#' ',(a1)+		;add a space to buffer
	move		tcon_man_year(a0),d0	;d0 = year
	bsr.s		word2ascii4		;add 4 year chars to buffer
;-------
	lea		GMT_tail_s(pc),a2
	str_copy	a2,a1
	subq		#1,a1
	move.b		#'+',(a1)+
	tcon_is_summer
	and.l		#3600,d0
	add.l		tcon_zoneseconds(a0),d0
	bpl.s		.keep_sign
	move.b		#'-',-1(a0)
	neg.l		d0
.keep_sign:
	divu		#3600,d0
	move.l		d0,d1
	bsr.s		word2ascii2
	move.b		#':',(a1)+
	swap		d1
	clr.l		d0
	move		d1,d0
	divu		#60,d0
	bsr.s		word2ascii2
	move.b		#CR,(a1)+
	move.b		#LF,(a1)+
	clr.b		(a1)+
	move.l		a1,d0
	movem.l		(sp)+,d1/a1-a2
	sub.l		a1,d0	;d0 = resulting string length, incl terminator
	rts
;
;End of man2ascii
;----------------------------------------------------------------------------
word2ascii4:
	and.l	#1<<16-1,d0
	divu	#1000,d0
	add	#'0',d0
	move.b	d0,(a1)+
	clr	d0
	swap	d0
	divu	#100,d0
	add	#'0',d0
	move.b	d0,(a1)+
	clr	d0
	swap	d0
word2ascii2:
	and.l	#1<<7-1,d0
	divu	#10,d0
	add	#'0',d0
	move.b	d0,(a1)+
	swap	d0
	add	#'0',d0
	move.b	d0,(a1)+
	rts
;----------------------------------------------------------------------------
serve_time_con_a4:			;a4 -> NetD_CON struct
	move.l	NetD_STX_p(pc),a3	;a3 -> NetD_STX struct  (from cookie)
	cmp	#NET_TIME_PORT,ND_CON_port(a4)	;NET_TIME server call ?
	beq.s	serve_NET_TIME		;if so, go serve NET_TIME
	cmp	#DAY_TIME_PORT,ND_CON_port(a4)	;DAY_TIME server call ?
	beq.s	serve_DAY_TIME		;if so, go serve DAY_TIME
;-------
;Here an erroneous NetD_CON has been delivered, so we refuse it
;-------
	moveq	#E_REFUSE,d0
	bra.s	exit_service		;go exit to caller
;------------------------------------
serve_NET_TIME:
	lea	tcon_data(pc),a0	;a0 -> our tcon structure
	tcon_real2tos			;get realtime in TOS form
	tcon_tos2man			;convert to human form
	tcon_man2net			;convert to network form
	lea	tcon_net_time(a0),a1	;a1 -> network time data
	moveq	#4,d0			;d0 = length of data
	bra.s	send_time_data
;------------------------------------
serve_DAY_TIME:
	lea	tcon_data(pc),a0	;a0 -> our tcon structure
	tcon_real2tos			;get realtime in TOS form
	tcon_tos2man			;convert to human form
	tcon_man2net			;\/ Dummy conversion is needed
	tcon_net2man			;/\ to get the weekday correct
	lea	buffer(pc),a1		;a1 -> buffer for DAYTIME string data
	bsr	man2ascii		;convert to string  d0 = len
send_time_data:
	NetD_send_CON	(a4),(a1),d0	;send the server response
	moveq		#E_NORMAL,d0	;flag NORMAL connection
exit_service:
	rts				;return to caller
;----------------------------------------------------------------------------
;End of:	Resident subroutines used by server
;----------------------------------------------------------------------------
;Start of:	Resident library code used by server
;----------------------------------------------------------------------------
	make	JAR_links
	make	TCON_links
	make	DOMAIN_links
;----------------------------------------------------------------------------
resident_end:
;all beyond this point will be released in going resident
resident_size	=	resident_end-text_start+$100
;----------------------------------------------------------------------------
;End of:	Resident server routines
;----------------------------------------------------------------------------
;Start of:	Non-resident server initialization code
;----------------------------------------------------------------------------
start_1:
	move.l		a0,d0
	bne.s		.have_basepage
	move.l		4(sp),d0
.have_basepage:
	move.l		d0,a5
	lea		mystack(pc),sp
	move.l		a0,d0
	bne		.ACC_launch
	gemdos		Mshrink,#0,(a5),#initial_size
;
	gemdos		Super,!
	move.l		d0,d7
	eval_cookie	#"STiK"
	move.l		d0,sting_drivers		;store -> DRV_LIST structure
	eval_cookie	#ND_XB_ID
	move.l		d0,NetD_STX_p			;store -> NetD cookie struct
.done_cookies:
	gemdos		Super|_ind,d7
;
	move.l		sting_drivers(pc),d0
	ble		.STiK_not_found
	move.l		d0,a3				;a3 -> DRV_LIST structure
	tst.l		NetD_STX_p
	ble		.NetD_not_found
;
	lea		DRV_LIST_magic(a3),a0
	lea		STiKmagic_s(pc),a1
	moveq		#10-1,d0
.strcmp_loop:					;loop to test STiKmagic of DRV_LIST
	cmpm.b		(a0)+,(a1)+
	dbne		d0,.strcmp_loop
	bne		.STiK_not_valid
;
	move.l		DRV_LIST_get_dftab(a3),a0	;a0 -> get_dftab function
	pea		TRANSPORT_DRIVER_s		;-(sp) = "TRANSPORT_TCPIP"
	jsr		(a0)				;call get_dftab
	addq		#4,sp
	move.l		d0,tpl				;store pointer in 'tpl'
	ble		.driver_not_valid
;
	move.l		DRV_LIST_get_dftab(a3),a0	;a0 -> get_dftab function
	pea		MODULE_DRIVER_s			;-(sp) = "MODULE_LAYER"
	jsr		(a0)				;call get_dftab
	addq		#4,sp
	move.l		d0,stx				;store pointer in 'stx'
	ble		.layer_not_valid
.install:
	NetD_init_SRV	my_SRV(pc)		;login server with NetD STX
	tst.l		d0			;test result
	bmi		.server_refused
	NetD_init_CON	my_SRV(pc),!,#NET_TIME_PORT		;request UDP TIME service
	NetD_init_CON	my_SRV(pc),!,#DAY_TIME_PORT		;request UDP DAYTIME service
	NetD_init_CON	my_SRV(pc),#BUF_SIZE,#NET_TIME_PORT	;request TCP TIME service
	NetD_init_CON	my_SRV(pc),#BUF_SIZE,#DAY_TIME_PORT	;request TCP DAYTIME service
	lea	tcon_data(pc),a0
	tcon_rd_zone
	tcon_rd_summer
.final_install:
	gemdos	Ptermres,#resident_size,#0
;-------------------------------------
.ACC_launch:
	lea	ACC_launch_s(pc),a0
	bsr.s	report_error
.loop:
	bra	.loop
;-------------------------------------
.NetD_not_found:
	lea	NetD_not_found_s,a0
	bra.s	.error_exit
;-------------------------------------
.STiK_not_found:
	lea	STiK_not_found_s,a0
	bra.s	.error_exit
;-------------------------------------
.STiK_not_valid:
	lea	STiK_not_valid_s,a0
	bra.s	.error_exit
;-------------------------------------
.driver_not_valid:
	lea	driver_not_valid_s,a0
	bra.s	.error_exit
;-------------------------------------
.layer_not_valid:
	lea	layer_not_valid_s(pc),a0
	bra.s	.error_exit
;-------------------------------------
.server_refused:
	lea	server_refused_s(pc),a0
.error_exit:
	bsr.s	report_error
	gemdos	Pterm,#E_ERROR
;-------------------------------------
report_error:
	move.l	a0,-(sp)
	lea	error_title_s(pc),a0
	bsr.s	Cconws_sub
	move.l	(sp)+,a0
	bsr.s	Cconws_sub
	lea	error_tail_s(pc),a0
Cconws_sub:
	gemdos	Cconws,(a0)
	rts
;----------------------------------------------------------------------------
;End of:	Non-resident server initialization code with tests
;----------------------------------------------------------------------------
;Start of:	Non-resident library code used by server
;----------------------------------------------------------------------------
	make	JAR_links
	make	TCON_links
	make	DOMAIN_links
;----------------------------------------------------------------------------
;End of:	Non-resident library code used by server
;----------------------------------------------------------------------------
text_limit:
text_size	= text_limit-text_start
	SECTION	DATA
data_start:
;----------------------------------------------------------------------------
;Start of:	Non-resident data used by server
;----------------------------------------------------------------------------
STiKmagic_s:
	dc.b	'STiKmagic',NUL
TRANSPORT_DRIVER_s:
	dc.b	'TRANSPORT_TCPIP',NUL
MODULE_DRIVER_s:
	dc.b	'MODULE_LAYER',NUL
;-------------------------------------
ACC_launch_s:
	dc.b	'This non-ACC, was launched as an ACC,',CR,LF
	dc.b	'so now you must reset the computer !',CR,LF
	dc.b	'I am looping forever to avoid damage',CR,LF
	dc.b	'that could occur if I try to exit !',CR,LF
	dc.b	NUL
;-------------------------------------
NetD_not_found_s:
	dc.b	'There is no NetD cookie in the jar !',CR,LF
	dc.b	NUL
;-------------------------------------
STiK_not_found_s:
	dc.b	'There is no STiK cookie in the jar !',CR,LF
	dc.b	NUL
;-------------------------------------
STiK_not_valid_s:
	dc.b	'The STiK cookie data is corrupt !',CR,LF
	dc.b	NUL
;-------------------------------------
driver_not_valid_s:
	dc.b	'The main STinG driver is not valid !',CR,LF
	dc.b	NUL
;-------------------------------------
layer_not_valid_s:
	dc.b	'The STinG module layer is not valid !',CR,LF
	dc.b	NUL
;-------------------------------------
server_refused_s:
	dc.b	'NetD STX refused login of T_SERVER !',CR,LF
	dc.b	NUL
;-------------------------------------
error_title_s:
	dc.b	BEL,CR,LF
	dc.b	'------------'
	M_TITLE
	dc.b	' '
	M_VERSION
	dc.b	'------------',CR,LF
	dc.b	NUL
;-------------------------------------
	EVEN
error_tail_s:
	M_TITLE
	dc.b	'installation aborted.',CR,LF
	dc.b	BEL,CR,LF,NUL
	EVEN
;----------------------------------------------------------------------------
;End of:	Non-resident data used by server
;----------------------------------------------------------------------------
data_limit:
data_size	=	data_limit-data_start
	SECTION	BSS
bss_start:
;----------------------------------------------------------------------------
		ds.l	200		;subroutine stack >= 100 longs
mystack:	ds.l	1		;top of subroutine stack
;----------------------------------------------------------------------------
bss_limit:
bss_size	=	bss_limit-bss_start
;----------------------------------------------------------------------------
initial_size	=	text_size+data_size+bss_size+$100
;----------------------------------------------------------------------------
;End of file:	T_SERVER.S
;----------------------------------------------------------------------------
