;*******************************************************************************
; Director - URL
;
; Copyright (C) 2003, Nick Craig-Wood and Philip Ludlam
;
;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., 59 Temple
;Place - Suite 330, Boston, MA 02111-1307, USA
;
;*******************************************************************************
;----h- Director.s.URL
; Name
;   URL
;
; Purpose
;   URL
;------
;*******************************************************************************


		TTL	> URL

		GET	OSLib:oslib.hdr.Wimp
		GET	OSLib:oslib.hdr.OSModule
		GET	OSLib:oslib.hdr.InetSuite
		GET	AsmLib2:hdr.RegsBoth
		GET	AsmLib2:hdr.MacrosBoth
		GET	h.WorkSpace
		GET	h.ListMacros
		GET	h.Constants
		GET	h.Memory
		GET	h.Task
		GET	h.Menus
		GET	h.BMG
		GET	h.ModuleHead

		AREA	|URL|, CODE, READONLY


;*******************************************************************************
;----s- Director.s.URL.URLBlock
; Name
;   URLBlock
;
; Purpose
;   URLBlock structure
;
; Source


			^	0
URLBlock_link		#	4
URLBlock_url		#	4
URLBlock_quiet		#	4
URLBlock_status		#	4
URLBlock		EQU	:INDEX: @

;------
;*******************************************************************************


;*******************************************************************************
;----f- Director.s.URL.URLBlockFind
; Name
;   URLBlockFind
;
; Purpose
;   This finds the given URL block in the URL list
;   or returns a pointer to the previous item
;
;
; Entry
;   r0  url
;
; Exit
;   r0  URLBlock
;   r1  previous URL block (if found)
;   Flags:
;     EQ means found
;     NE means not found
;------
;*******************************************************************************


URLBlockFind	ROUTINE	"r2-r4"

		ADR	r4, URLAnchor			; r4  list anchor

loop$l		ListWalk	r4, r2			; r2  previous, r4  current
		BEQ	notfound$l

		LDR	r1, [r4, #URLBlock_url]
		BL	strcmpi				; to_find - current
		BGT	loop$l				; continue until alphabetical place found
		BNE	notfound$l

found$l		MOV	r0, r4				; point to current URLBlock
		MOV	r1, r2
		SetZ
		EXIT

notfound$l	MOV	r0, r4				; point to current URLBlock
		MOV	r1, r2
		ClearZ
		EXIT


;*******************************************************************************
;----f- Director.s.URL.URLBlockFindStatus
; Name
;   URLBlockFindStatus
;
; Purpose
;   This finds the URL block which has the internal status given
;
; Entry
;   r0 = status
;
; Exit
;   r0  URLBlock
;   r1  previous URL block (if found)
;   Flags:
;     EQ means found
;     NE means not found
;------
;*******************************************************************************


URLBlockFindStatus	ROUTINE	"r2-r4"

		MOV	r2, r0				; r2 = status value to find
		ADR	r0, URLAnchor			; r0  URLBlock

find$l		ListWalk	r0, r1			; r0  URLBlock, r1  previous
		BEQ	notfound$l
		LDR	lr, [r0, #URLBlock_status]
		CMP	lr, r2
		BNE	find$l

found$l		SetZ
		EXIT

notfound$l	ClearZ
		EXIT


;*******************************************************************************
;----f- Director.s.URL.URLBlockDestroy
; Name
;   URLBlockDestroy
;
; Purpose
;   This destroys a URL block and unlinks it from the list.
;   It releases any memory also attached.
;
; Entry
;   r0  URLBlock
;   r1  previous URL block
;
; Exit
;   none
;------
;*******************************************************************************


URLBlockDestroy	ROUTINE	"r0-r3", EXPORT

		MOV	r3, r0				; r3  URLBlock
		UnLink	r3, r1, lr			; unlink the URLBlock

		LDR	r0, [r3, #URLBlock_url]		; free attached items
		BL	free

		MOV	r0, r3				; free block
		BL	free

		EXIT


;*******************************************************************************
;----f- Director.s.URL.URLBlockListDestroy
; Name
;   URLBlockListDestroy
;
; Purpose
;   This destroys all the URL blocks in the list
;
; Entry
;   none
;
; Exit
;   none
;------
;*******************************************************************************


URLBlockListDestroy	ROUTINE	"r0-r3", EXPORT

		ADR	r0, URLAnchor
loop$l		ListWalkForDestruction	r0, r1, r2
		BEQ	exitloop$l
		BL	URLBlockDestroy
		B	loop$l

exitloop$l	EXIT


;*******************************************************************************
;----f- Director.s.URL.DoMessage_InetSuiteOpenURL_Ack
; Name
;   DoMessage_InetSuiteOpenURL_Ack
;
; Purpose
;   Called when the WIMP sends a InetSuiteOpenURL message back to our task.
;
; Entry
;   r11  message block
;
; Exit
;   none
;------
;*******************************************************************************


DoMessage_InetSuiteOpenURL_Ack	ROUTINE_SF "", EXPORT
command$l	#	StringSize
varval$l	#	StringSize
varname$l	#	24
		END_SF

		MOV	r0, #$Name._URL_InetSuite	; Find URL being processed by InetSuite protocol
		BL	URLBlockFindStatus		; r0  URLBlock, r1  previous
		BNE	exit_now$l

		MOV	r11, r0				; r11  URLBlock
		MOV	r10, r1				; r10  previous URLBlock

		ADR	r0, url$l			; from
		ADR	r1, varname$l			; to
		BL	strcpy				; copy "Alias..." string

		LDR	r0, [r11, #URLBlock_url]	; from
		SUB	r1, r1, #1			; to
		MOV	r2, #":"			; term = ":"
		BL	strcpyt				; copy protocol string http, ftp etc.

		ADR	r0, https$l
		BL	strcmpil
		BNE	skiphttps$l			; if it's https:// 
		MOV	r0, #0
		STRB	r0, [r1, #4]			;  then terminate it after 'http'

skiphttps$l	ADR	r0, varname$l
		ADR	r1, varval$l
		MOV	r2, #StringSize
		MOV	r3, #0
		MOV	r4, #0
		SWI	XOS_ReadVarVal
		BVS	error$l

		MOV	r4, r2
		LDR	r0, [r11, #URLBlock_url]	; URL
		ADR	r1, command$l
		MOV	r2, #StringSize
		ADR	r3, varval$l
		SWI	XOS_SubstituteArgs
		BVS	error$l

		ADR	r0, command$l
		BL	StartWimpTask			; run the command
		BVS	error$l				; report error

exit$l		MOV	r0, r11				; r0  URLBlock
		MOV	r1, r10				; r1  previous URLBlock
		BL	URLBlockDestroy
exit_now$l	EXIT

error$l		LDR	r1, [r11, #URLBlock_quiet]
		CMP	r1, #0
		BNE	exit$l

		MOV	r0, r11				; r0  URLBlock
		MOV	r1, r10				; r1  previous URLBlock
		BL	URLBlockDestroy

		ADR	r0, errmsg$l
		BL	AlertMT
		EXIT

url$l		DCB	"Alias$URLOpen_", 0
https$l		DCB	"https:", 0
		ALIGN

errmsg$l	ERROR	"$CannotLaunchURL", Error_CannotLaunchURL
		ALIGN


;*******************************************************************************
;----f- Director.s.URL.DoInetSuite
; Name
;   DoInetSuite
;
; Purpose
;
;
; Entry
;   r0  URLBlock
;
; Exit
;   If an error occured:
;     r0 = pointer to valid error block
;     VS
;   Otherwise
;     VC
;------
;*******************************************************************************


DoInetSuite  	ROUTINE_SF	""
message$l	#	StringSize
		END_SF

		MOV	r11, r0
		MOV	r0, #$Name._URL_InetSuite	; InetSuite message processing it
		STR	r0, [r11, #URLBlock_status]

		ADR	r0, message$l
		MOV	r1, #StringSize
		BL	memclear			; set message block to 0

		LDR	r0, [r11, #URLBlock_url]
		ADR	r1, message$l + Wimp_MessageHeader_data  + InetSuite_MessageOpenURL_url
		BL	strcpy

		ADR	r0 ,message$l + Wimp_MessageHeader_data + InetSuite_MessageOpenURL_url
		BL	strlen1
		ADD	r0, r0, #Wimp_MessageHeader_data + InetSuite_MessageOpenURL_url + 3
		BIC	r0, r0, #3			; align
		STR	r0, message$l + Wimp_MessageHeader_size

		LDR	r0, =Message_InetSuiteOpenURL	; = &4AF80
		STR	r0, message$l + Wimp_MessageHeader_action ; type of message

		MOV	r0, #Wimp_UserMessageRecorded	; = 18
		ADR	r1, message$l
		MOV	r2, #0				; broadcast
		SWI	XWimp_SendMessage		; send the message

		EXIT
		LTORG


;*******************************************************************************
;----f- Director.s.URL.URLBlockListDirectorURL
; Name
;   URLBlockListDirectorURL
;
; Purpose
;   Called when the DirectorURL bit in the PollWord is set
;   DirectorURL has been called and set up an URLBlock.
;
; Entry
;   none
;
; Exit
;   none
;------
;*******************************************************************************


URLBlockListDirectorURL	ROUTINE "r0", EXPORT

		MOV	r0, #$Name._URL_InetSuite	; find a URL where the InetSuite method worked
		BL	URLBlockFindStatus		; r0  URLBlock
		BNE	skipdestroy$l
		BL	URLBlockDestroy
		BVS	error$l
		B	exit$l

skipdestroy$l
		MOV	r0, #$Name._URL_NotClaimed	; find a URL which to try
		BL	URLBlockFindStatus		; r0  URLBlock
		BNE	skipInetSuite$l
		BL	DoInetSuite
		BVS	error$l
		B	exit$l

skipInetSuite$l
		MOV	r0, #$Name._PollWord_DirectorURL ; no more URLs to do.
		BL	BIC_PollWord			; unset PollWord

exit$l		EXIT

error$l		EXIT_ERR


;*******************************************************************************
;----f- Director.s.URL.Star_DirectorURL
; Name
;   Star_DirectorURL
;
; Purpose
;   This adds a DirectorURL file to the block
;
; Theory:
;   Add URL to memory block
;   Set PollWord
;
; Entry
;   none
;
; Exit
;   none
;------
;*******************************************************************************


Help_$Name.URL	FOREXPORT
		[	OSVersion = 310
		DCB	"This opens a URL.", 13
		|
		DCB	"Help_DirectorURL", 0
		]

Syntax_$Name.URL	FOREXPORT
		[	OSVersion = 310
		DCB	"Syntax: *$Name.URL <url> [<-q | -quiet>]", 0
		|
		DCB	"Syntax_DirectorURL", 0
		]
		ALIGN

Args_$Name.URL	DCB	"/g,q=quiet/s", 0
		ALIGN

Star_$Name.URL	FOREXPORT
		LDR	wp, [r12]

Do$Name.URL	SaveRegs
		ROUTINE_SF	NONE
scratch$l	#	0
arg_url$l	#	4
arg_quiet$l	#	4
space$l		#	scratch_size - :INDEX: @
		END_SF

		MOV	r1, r0				; translate given string
		ADR	r0, Args_$Name.URL
		ADR	r2, scratch$l
		MOV	r3, #scratch_size
		SWI	XOS_ReadArgs
		BVS	ErrorReturn

		LDR	r0, arg_url$l
		BL	sort_out_gstrans

kill$l		; Do we have this URL already?
		BL	URLBlockFind			; r0  URLBlock, r1  previous
		BNE	notfound$l
		BL	URLBlockDestroy
		B	kill$l

notfound$l	MOV	r7, r1				; r7  link

		MOV	r0, #URLBlock
		BL	malloc
		BVS	ErrorReturn
		MOV	r11, r0				; r11  URLBlock
		MOV	r1, #URLBlock
		BL	memclear			; clear the URL block to 0
		LDR	r0, arg_quiet$l
		STR	r0, [r11, #URLBlock_quiet]
		LDR	r0, arg_url$l
		BL	strdup
		BVS	ErrorReturn
		STR	r0, [r11, #URLBlock_url]	; store the URL

		Link	r11, r7, lr			; link the block into the correct place in the list

		MOV	r0, #$Name._PollWord_DirectorURL
		BL	ORR_PollWord			; Set the PollWord

		B	NormalReturn

;*******************************************************************************

		END
