downloadHTTP.icl 1.89 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
module downloadHTTP

//	**************************************************************************************************
//
//	A program that uses HTTP to download the beginning of a HTML page
//
//	The program has been written in Clean 1.3.1 and uses the Clean Standard Object I/O library 1.1
//	
//	**************************************************************************************************
import StdIO
import	StdEnv, StdTCP, StdMaybe
from	StdSystem import ticksPerSecond

server	:== "www.cs.kun.nl"
path	:== "/~clean/"		// the Clean homepage

httpCommand	= "GET "+++path+++" HTTP/1.0\xD\xA\xD\xA"
port	:== 80

Start world
	#	(console, world)			= stdio world

  // get the IP address of the server

		(mbIPAddr, world)			= lookupIPAddress server world
	|	isNothing mbIPAddr
		#	console					= fwrites (server+++" not found\n") console
		= fclose console world

  // connect

	#	(tReport, mbDuplexChan, world)
									= connectTCP_MT (Just (15*ticksPerSecond))
									                (fromJust mbIPAddr, port) world
	|	tReport<>TR_Success
		#!	console 				= fwrites (   server+++" does not respond on port "
											   +++toString port+++"\n") console
		= fclose console world
	#!	console 					= fwrites (server+++" responded on port "+++toString port+++"\n")
											  console
		{ sChannel=sc, rChannel=rc }= fromJust mbDuplexChan
//	**************************************************************************************************

  // send http command

		(sc, world)					= send (toByteSeq httpCommand) sc world

  // receive answer

		(tReport, mbBs, rc, world)	= receive_MT (Just (20*ticksPerSecond)) rc world
		console	= case tReport of
					TR_Success		-> fwrites (toString (fromJust mbBs)) console
					_				-> fwrites (server+++" does not send anything (timeout expired)")
											   console

  // close

		world						= closeRChannel rc world
		world						= closeChannel sc world
	= fclose console world