/****************************************************************************
   
    OS/A65 Version 1.4.0
    Multitasking Operating System for 6502 Computers

    Copyright (C) 1989-1997 Andre Fachat

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

****************************************************************************/

	.(

#define	TCB_WS		TCB_CONN
#define	TCB_WSLOT	(TCB_CONN+1)
#define	TCB_WSTR	(TCB_CONN+2)
#define	TCB_WTASK	(TCB_CONN+3)
#define	TCB_WCNT	(TCB_CONN+4)

#define	WS_FREE		0
#define	WS_RXD		1	/* filename received */
#define	WS_FSENT	2	/* filename sent to filesystem */
#define	WS_WR		3	/* get data and send it */
#define	WS_WR_WAIT	4	/* send prepared data block */
#define	WS_WR_WEOF	5	/* send last data block */
#define	WS_CLOSING	6	/* closing */
#define	WS_CLOSED	7	/* closed */

#define	WE_ILLFORMED	1	/* illformed request */
#define	WE_TRYAGAIN	2	/* temporary resource shortage */
#define	WE_NOTFOUND	3	/* file not found */

www_srv	.byte 0,0,0,0, 0,0, 80,0, SFL_MULT
        .word wwwsrv_queue-1, wwwsrv_loop-1, wwwsrv_signal-1

	.zero
zp	.word 0
	.text

&wwwsrv_init .(
	lda #<www_srv
	ldy #>www_srv
	jmp tcp_listen
	.)

wwwsrv_queue .(
	stx pslot
	jsr getbadr
	sta pp
	sty pp+1

DB("wwwsrv_queue: tcbp=")
lda tcbp+1:jsr EHexout:lda tcbp:jsr EHexout:jsr ECrlfout

	ldy #TCB_WS
	lda (tcbp),y
	cmp #WS_FREE
	beq noclose
	jmp close
noclose
	ldy #0
	lda (pp),y
	clc
	adc pp
	sta pd
	iny
	lda (pp),y
	adc pp+1
	sta pd+1
	iny
	lda (pp),y
	sta pdl
	iny
	lda (pp),y
	sta pdl+1

ldy #0:x4 lda (pd),y:jsr ECout:iny:cpy pdl:bcc x4

	lda pdl+1
	bne oklen
	lda pdl
	cmp #5		/* at least GET + space + one_char_URL */
	bcc noget1
oklen
	ldy #0
	lda (pd),y
	cmp #"G"
	beq get2
	cmp #"g"
	bne noget1
get2	iny
	lda (pd),y
	cmp #"E"
	beq get3
	cmp #"e"
	bne noget1
get3	iny
	lda (pd),y
	cmp #"T"
	beq get4
	cmp #"t"
	beq get4
noget1	jmp noget
get4	
	iny
	beq noget1	/* length overflow */
	cpy pdl
	bcc ok		/* low counter below length */
	lda pdl+1
	beq noget1	/* gotten to end length */
ok
	lda (pd),y
	cmp #" "
	beq get4

	tya
	sta ppl		/* well, we need temp. storage... */
	clc
	adc pd
	sta pd
	bcc a0
	inc pd+1
a0	lda pdl
	sec
	sbc ppl
	sta pdl
	bcs a1
	dec pdl+1
a1	
	ldy #0
	beq a2a
a2	iny
	beq noget1	/* length overflow */
a2a	cpy pdl
	bcc ok1		/* low counter below length */
	lda pdl+1
	beq noget1	/* gotten to end length */
ok1
	lda (pd),y
	cmp #32
	bcc end
	cmp #" "
	beq end
	cmp #"#"
	beq end
	cmp #"/"
	bne a2
	lda #DIRSIGN
	sta (pd),y
	jmp a2
end	sty pdl
	lda #0
	sta pdl+1

	cpy #64		/* filename too long! */
	bcs noget	

DB("GET detected:")
ldy #0:x3 lda (pd),y:jsr ECout:iny:cpy pdl:bcc x3
DB(", len=")
lda pdl:jsr EHexout:jsr ECrlfout

	ldy #0
	lda pd
	sec
	sbc pp
	sta (pp),y
	iny
	lda pd+1
	sbc pp+1
	sta (pp),y
	iny
	lda pdl
	sta (pp),y
	iny
	lda pdl+1
	sta (pp),y

	lda pslot
	ldy #TCB_WSLOT
	sta (tcbp),y
	ldy #TCB_WS
	lda #WS_RXD
	sta (tcbp),y
	ldy #TCB_WCNT
	lda #100
	sta (tcbp),y
	clc
	rts

noget	lda pslot
	pha
	ldx #WE_ILLFORMED
	jsr senderr
	pla
	sta pslot
	lda #WS_CLOSING
set
	ldy #TCB_WS
	sta (tcbp),y
close 
	ldx pslot
	jsr bfree

	clc
	rts
	.)

senderr	.(
	dex
	txa
	asl
	tax

	lda msgtab,x
	sta zp
	lda msgtab+1,x
	sta zp+1

	lda lentab,x
	clc
	adc #TCP_DOFFSET
	pha
	lda lentab+1,x
	adc #0
	tay
	pla
	jsr balloc
	bcs errp
	lda #TCP_DOFFSET
	jsr getpinfo

	ldy #0
	lda pd
	sec
	sbc pp
	sta (pp),y
	iny
	lda pd+1
	sbc pp+1
	sta (pd),y
	iny
	lda pdl
	sta (pp),y
	iny
	lda pdl+1
	sta (pp),y

	ldy #0
loop	cpy pdl
	bcc okl
	lda pdl+1
	beq end
okl	
	lda (zp),y
	sta (pd),y
	iny
	bne loop
	dec pdl+1
	jmp loop

end	ldx pslot
	jmp tx_queue_packet
errp
	rts

msgtab	.word m_illf, m_again, m_notf
lentab	.word e_illf-m_illf, e_again-m_again, e_notf-m_notf

m_illf	.asc "<HTML>^m^j<HEAD>^m^j<TITLE>Error</TITLE>^m^j</HEAD>^m^j"
	.asc "<BODY>^m^j<H1>Error 400</H1>^m^j^m^j"
	.asc "<A HREF=",34,"http://www.tu-chemnitz.de/~fachat/csa",34,">OS/A65</A>"
	.asc " TCP simple WWW server error: illformed request^m^j"
	.asc "</BODY>^m^j</HTML>^m^j"
e_illf
m_again	.asc "<HTML>^m^j<HEAD>^m^j<TITLE>Error</TITLE>^m^j</HEAD>^m^j"
	.asc "<BODY>^m^j<H1>Error 400</H1>^m^j^m^j"
	.asc "<A HREF=",34,"http://www.tu-chemnitz.de/~fachat/csa",34,">OS/A65</A>"
	.asc " TCP simple WWW server error: try again^m^j"
	.asc "</BODY>^m^j</HTML>^m^j"
e_again
m_notf	.asc "<HTML>^m^j<HEAD>^m^j<TITLE>Error</TITLE>^m^j</HEAD>^m^j"
	.asc "<BODY>^m^j<H1>Error 400</H1>^m^j^m^j"
	.asc "<A HREF=",34,"http://www.tu-chemnitz.de/~fachat/csa",34,">OS/A65</A>"
	.asc " TCP simple WWW server error: file not found^m^j"
	.asc "</BODY>^m^j</HTML>^m^j"
e_notf

	.)

wwwsrv_loop .(
	ldy #TCB_WS
	lda (tcbp),y
	cmp #WS_CLOSED+1
	bcc noerr
	jmp err
noerr
	asl
	tay
	lda looptab+1,y
	pha
	lda looptab,y
	pha
	rts

looptab	.word loop_free-1, loop_rxd-1, loop_sent-1, loop_wr-1
	.word loop_wait-1, loop_wait-1, loop_close-1, loop_closed-1

loop_rxd .(
	ldy #TCB_WSLOT
	lda (tcbp),y
	tax
	jsr getbadr
	sta pp
	sty pp+1
	ldy #0
	lda (pp),y
	clc
	adc pp
	sta pd
	iny
	lda (pp),y
	adc pp+1
	sta pd+1
	iny
	lda (pp),y
	sta pdl
	iny
	lda (pp),y
	sta pdl+1

#ifdef NOMMU
	ldx #SEM_SENDBUF
	sec
	jsr PSEM
	bcc semerrok
	jmp semerr
semerrok
#endif
	inc sendbuf

	lda #WWW_DRV
	sta PCBUF+FS_OPEN_DRV
	lda #0
	sta PCBUF+FS_OPEN_PFAD
	
	jsr GETSTR
	bcs strerr

	txa
	sta PCBUF+FS_OPEN_STR
	ldy #TCB_WSTR
	sta (tcbp),y

	ldx #0
l0	lda wwwpath,x
	beq l1
	sta PCBUF+FS_OPEN_NAME,x
	inx
	bne l0
l1
	ldy #0
	lda (pd),y
	cmp #"/"	;DIRSIGN
	bne l2
	iny
l2
	cpy pdl
	bcs l3
	lda (pd),y
	cmp #" "
	beq l3
	sta PCBUF+FS_OPEN_NAME,x
	iny
	inx
	bne l2
l3
	txa
	beq def
	lda PCBUF+FS_OPEN_NAME-1,x
	cmp #DIRSIGN
	bne l4
def
	ldy #0
l5	lda wwwdef,y
	beq l4
	sta PCBUF+FS_OPEN_NAME,x
	iny
	inx
	bne l5
l4
	lda #0
	sta PCBUF+FS_OPEN_NAME,x
	inx
	txa
	clc
	adc #FS_OPEN_NAME
	tay
	lda #FS_OPEN_RD
	ldx #SEND_FM
	jsr SEND	/* warning: this blocks if own task or weird confs! */
	bcs send_err

	txa
	ldy #TCB_WTASK
	sta (tcbp),y

	lda #WS_FSENT
	ldy #TCB_WS
	sta (tcbp),y

	ldy #TCB_WSLOT
	lda (tcbp),y
	tax
	jsr bfree

	clc
	rts

send_err
	ldy #TCB_WSTR
	lda (tcbp),y
	tax
	jsr FRESTR
strerr	
	dec sendbuf
#ifdef NOMMU
	ldx #SEM_SENDBUF
	jsr VSEM
semerr
#endif
	ldy #TCB_WCNT
	lda (tcbp),y
	sec
	sbc #1
	sta (tcbp),y
	bne end

	ldx #WE_TRYAGAIN
	jsr senderr

	ldy #TCB_WSLOT
	lda (tcbp),y
	tax
	jsr bfree

	ldy #TCB_WS
	lda #WS_CLOSING
	sta (tcbp),y

end	rts

wwwpath	.byte WWW_PATH,0
wwwdef	.byte WWW_DEFAULT,0
	.)

loop_sent .(
	ldy #TCB_WTASK
	lda (tcbp),y
	tax
	clc
	jsr XRECEIVE
	bcc gotit
	rts
gotit
	dec sendbuf
#ifdef NOMMU
	pha
	ldx #SEM_SENDBUF
	jsr VSEM
	pla
#endif
	cmp #0
	bne err1
	
	lda #WS_WR
set
	ldy #TCB_WS
	sta (tcbp),y
	rts

err1	ldx #WE_NOTFOUND
	jsr senderr
	
	ldy #TCB_WSTR
	lda (tcbp),y
	tax
	jsr FRESTR

	lda #WS_CLOSING
	jmp set
	.)

loop_wr	.(
/*
DB("loop_wr:")
jsr printlist:jsr printmem
*/
	ldy #TCB_WSTR
	lda (tcbp),y
	tax
	lda #SC_STAT
	jsr STRCMD
	cmp #E_SFULL
	beq send
	cmp #E_SHWM
	beq send
	lda #SC_RWANZ
	jsr STRCMD
	cmp #0
	beq send
l0c1	rts
send
        lda #TCP_DOFFSET+64
        ldy #0
        jsr balloc
        bcs l0c1
	;stx pslot
	;sta pp
	;sty pp+1
        txa
        ldy #TCB_WSLOT
        sta (tcbp),y
        lda #TCP_DOFFSET
	jsr getpinfo
/*
DB("Write block to pp=")
lda pp+1:jsr EHexout:lda pp:jsr EHexout:DB(", pd=")
lda pd+1:jsr EHexout:lda pd:jsr EHexout
jsr ECrlfout

DB("sadr=") 
ldy #TCB_WSLOT: lda (tcbp),y: tax: jsr getbadr: pha: tya: jsr EHexout: pla: jsr EHexout: jsr ECrlfout
*/
	ldy #TCB_WSTR
	lda (tcbp),y
	tax
	ldy #0
wrl	jsr GETC
	bcs wrle
	sta (pd),y
	iny
	cpy #64
	bcc wrl
	lda #E_OK
wrle	pha
	tya

	pha
	ldy #TCB_WSLOT
	lda (tcbp),y
	tax
/*
DB("pd=")
lda pd+1:jsr EHexout:lda pd:jsr EHexout:jsr ECrlfout
DB("sadr=")
ldy #TCB_WSLOT:lda (tcbp),y:tax:jsr getbadr:pha:tya:jsr EHexout:pla:jsr EHexout:jsr ECrlfout
*/
	pla

	sta pdl
        ldy #0
        clc
        adc #TCP_DOFFSET
        bcc w2
        iny
w2      jsr btrunc
/*
DB("pp=")
lda pp+1:jsr EHexout:lda pp:jsr EHexout
DB("sadr=")
ldy #TCB_WSLOT:lda (tcbp),y:tax:jsr getbadr:pha:tya:jsr EHexout:pla:jsr EHexout:jsr ECrlfout
*/
        ldy #0
        lda #<TCP_DOFFSET
        sta (pp),y
        iny
        lda #>TCP_DOFFSET
        sta (pp),y
        iny
        lda pdl
        sta (pp),y
        iny
        lda #0
        sta (pp),y
        pla

        cmp #E_EOF
        beq wend
        lda #WS_WR_WAIT
	.byt $2c
wend    lda #WS_WR_WEOF
	ldy #TCB_WS
	sta (tcbp),y

	ldy #TCB_WSLOT
	lda (tcbp),y
/*pha:DB("slot="):pla:pha:jsr EHexout:jsr ECrlfout:pla*/
	tax
	jsr incownr
	jsr tx_queue_packet
	bcc send_ok
	rts
	.)

loop_wait .(
	ldy #TCB_WSLOT
	lda (tcbp),y
	tax
	jsr incownr
	jsr queueslot
	bcs end
&send_ok
	ldy #TCB_WSLOT
	lda (tcbp),y
	tax
	jsr bfree

	ldy #TCB_WS
	lda (tcbp),y
	cmp #WS_WR_WEOF
	bne noeof

	ldy #TCB_WSTR
	lda (tcbp),y
	tax
	lda #SC_NUL
	jsr STRCMD

	lda #WS_CLOSING
	.byt $2c
noeof	lda #WS_WR
	ldy #TCB_WS
	sta (tcbp),y
end	rts
	.)
	
loop_close
err	ldy #TCB_WS
	lda #WS_CLOSED
	sta (tcbp),y

	ldx conn
	jsr tcp_close
loop_closed
loop_free rts
	.)

wwwsrv_signal .(
pha:
DB("wwwsrv_signal = "):pla:pha:jsr EHexout
DB(", tcbp="):lda tcbp+1:jsr EHexout:lda tcbp:jsr EHexout:jsr ECrlfout
pla
inc $d020
	pha

	ldy #TCB_WS
	lda (tcbp),y
	cmp #WS_FSENT
	bne nosent

	ldy #TCB_WTASK		/* unlock filesystem by receiving msg */
	lda (tcbp),y
	tax
	sec
	jsr XRECEIVE

	ldy #TCB_WSTR
	lda (tcbp),y
	tax	
	lda PCBUF+FS_X_ERR
	beq relbuf
	lda #SC_EOF
	jsr STRCMD
relbuf
	dec sendbuf
#ifdef NOMMU
	ldx #SEM_SENDBUF
	jsr VSEM
#endif
	jmp checkstr

nosent	cmp #WS_WR_WAIT
	beq wait
	cmp #WS_WR_WEOF
	bne nowait
wait	ldy #TCB_WSLOT
	lda (tcbp),y
	tax
	jsr bfree
nowait	
checkstr
	ldy #TCB_WS
	lda (tcbp),y
	cmp #WS_FSENT
	bcc end1
	cmp #WS_CLOSING
	bcc end1
	ldy #TCB_WSTR
	lda (tcbp),y
	tax
	lda #SC_NUL
	jsr STRCMD

end1	lda #WS_CLOSED
	ldy #TCB_WS
	sta (tcbp),y

	pla
	jmp tcp_signal
	.)

	.)

