nettobac  0.0.0
Network features for FreeBASIC code
example_server.bas
Go to the documentation of this file.
1 /'* \file example_server.bas
2 \brief Example code to test the \Proj package in a client scenario
3 
4 Copyright (C) GPLv3, see ReadMe.md for details.
5 
6 \since 0.0.0
7 '/
8 
9 #INCLUDE ONCE "nettobac.bas"
10 #INCLUDE ONCE "nettobac_http.bas"
11 
12 DIM SHARED AS STRING _
13  HTML1 _ '*< The startpage, loaded from local data folder
14  , HTML2 _ '*< The second page, loaded from local data folder
15  , ICON _ '*< An icon, loded over web
16  , HTTP _ '*< The HTTP header
17  , EMSG '*< The HTTP error message
18 
19 
20 /'* \brief Callback function to handle a new connection
21 \param Ser the calling server instance
22 \param Con the connection in use
23 \returns 0 (zero) to continue the server main loop, any other value to exit
24 
25 This is a callback function that gets called by function doServer() in
26 case of a new client connection request. It just outputs a message
27 at the console window.
28 
29 \since 0.0.0
30 '/
31 FUNCTION newConn(BYVAL Ser AS nettobacServer PTR, BYVAL Con AS n2bConnection PTR) AS INTEGER
32  ?!"Client connected!\n"
33  RETURN 0
34 END FUNCTION
35 
36 
37 /'* \brief Callback function to handle a disconnect
38 \param Ser the calling server instance
39 \param Con the connection in use
40 \returns 0 (zero) to continue the server main loop, any other value to exit
41 
42 This is a callback function that gets called by function doServer() in
43 case of a client peer closed the connection. It just outputs a message
44 at the console window.
45 
46 \since 0.0.0
47 '/
48 FUNCTION disConn(BYVAL Ser AS nettobacServer PTR, BYVAL Con AS n2bConnection PTR) AS INTEGER
49  ?!"Client disconnected!\n"
50  RETURN 0
51 END FUNCTION
52 
53 
54 /'* \brief Callback function to handle a client request
55 \param Con the connection in use
56 \param Dat the message from the client
57 \returns 0 (zero) to continue the server main loop, any other value to exit
58 
59 This is a callback function that gets called by function doServer() in
60 case of a data request from a connected client peer. It analyses the
61 request (message in `Dat`) and sends an appropriate response (via hppt
62 protocol). Some responses are pre-defined (read from files), others get
63 generated depending on the client message.
64 
65 \since 0.0.0
66 '/
67 FUNCTION newData(BYVAL Con AS n2bConnection PTR, BYREF Dat AS STRING) AS INTEGER
68 '&typedef n2bConnection* n2bConnection_PTR;
69  ?!"Client message:\n" & dat
70  SELECT CASE LEFT(Dat, 4)
71  CASE "GET "
72  IF MID(Dat, 5, 2) = "/ " ORELSE _
73  MID(Dat, 5, 11) = "/demo1.html" THEN
74  ?"sending HTML1 ...";
75  Con->nPut(HTTP & LEN(HTML1) & HEADEREND & HTML1)
76  ?!" done\n"
77  ELSEIF MID(Dat, 5, 11) = "/demo2.html" THEN
78  ?"sending HTML2 ...";
79  Con->nPut(HTTP & LEN(HTML2) & HEADEREND & HTML2)
80  ?!" done\n"
81  ELSEIF MID(Dat, 5, 12) = "/favicon.ico" THEN
82  ?"sending ICON ...";
83  Con->nPut(HTTP & LEN(ICON) & HEADEREND & ICON)
84  ?!" done\n"
85  ELSEIF MID(Dat, 5, 9) = "/FORM?id=" THEN
86  VAR p = INSTR( Dat, "&password=") _
87  , q = INSTR(p, Dat, "&button=") _
88  , t = "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" " _
89  & """http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">" _
90  & "<html><body>" _
91  & "<b>Login data</b>" _
92  & "<p>ID = " & urlDecode(MID(Dat, 14, p - 14)) _
93  & "<p>Password = " & urlDecode(MID(Dat, p + 10, q - p - 10)) _
94  & "<p><a href=""demo1.html"">Go back to start page</a>" _
95  & "</body></html>"
96  ?"sending FORM response ...";
97  Con->nPut(HTTP & LEN(t) & HEADEREND & t)
98  ?!" done\n"
99  ELSEIF MID(Dat, 5, 5) = "/EXIT" THEN
100  ?"EXIT --> server shuting down"
101  RETURN 1
102  ELSE
103  VAR e = "HTTP/1.1 404 Not Found" _
104  & "Date: Sat, 31 Oct 2015 06:16:38 GMT" _
105  & "Server: Apache" _
106  & "Vary: Accept-Encoding" _
107  & "Content-Length: 239" _
108  & "Connection: close" _
109  & "Content-Type: text/html; charset=iso-8859-1" _
110  & HEADEREND _
111  & "<!DOCTYPE HTML PUBLIC ""-//IETF//DTD HTML 2.0//EN"">" _
112  & "<html><head>" _
113  & "<title>404 Not Found</title>" _
114  & "</head><body>" _
115  & "<h1>Not Found</h1>" _
116  & "<p>The requested URL was not found on this server.</p>" _
117  & "</body></html>" _
118 
119  ?"sending ERROR ...";
120  Con->nPut(HTTP & LEN(e) & HEADEREND & e)
121  ?!" done\n"
122  END IF
123  END SELECT : RETURN 0
124 END FUNCTION
125 
126 
127 /'* \brief Operate as a server
128 \returns the value to `END` the program
129 
130 This function creates a nettobacServer instance and check in a loop for
131 new connection requests and for requests from already connected client
132 peers. In case of events is call callback functions
133 
134 \Item{newConn} when a new client requests a connection
135 
136 \Item{newData} when a connected client requests data
137 
138 \Item{disConn} when a connection gets closed
139 
140 The loop continues when the function returns 0 (zero). Ohterwise all
141 connections get closed and the nettobacServer instance gets `DELETE`d.
142 Also any keystroke breaks the main loop.
143 
144 \since 0.0.0
145 '/
146 FUNCTION doServer(BYVAL Port AS USHORT = 3490) AS INTEGER
147  VAR server = NEW nettobacServer(Port) ' create server instance for Port
148  WITH *server
149  IF .Errr THEN ?"error: " & *.Errr & " failed" : RETURN 1
150  ?"server started (port = " & Port & ")"
151  WHILE 0 = LEN(INKEY())
152  VAR con = .nOpen() '&nettobacServer.nOpen();
153  IF .Errr THEN
154  SELECT CASE *.Errr
155  CASE "server isset" ' drop this message (it means no connection request pending)
156  CASE ELSE : ?"error: " & *.Errr & " failed" ' show other
157  END SELECT : .Errr = 0 ' reset error message
158  ELSE
159  IF con THEN IF newConn(server, con) THEN EXIT WHILE
160  END IF
161 
162  FOR i AS INTEGER = UBOUND(.Slots) TO 0 STEP -1
163  VAR dat = "", con = .Slots(i) '&n2bConnection* con;
164  con->nGet(dat, 0) ' check for new message (single shot)
165  IF .Errr THEN ' got error
166  SELECT CASE *.Errr ' no data, just an error
167  CASE "retry" ' drop this message (it means no data pending)
168  CASE "disconnected" ' peer disconnection
169  IF disConn(server, con) THEN EXIT WHILE
170  .nClose(con) ' close connection
171  CASE ELSE : ?"error: " & *.Errr & " failed" ' show other
172  END SELECT : .Errr = 0 ' reset error message
173  END IF
174  IF LEN(dat) ANDALSO newData(con, dat) THEN EXIT WHILE
175  NEXT : SLEEP 10
176  WEND
177  END WITH
178  DELETE server : RETURN 0
179 END FUNCTION
180 
181 
182 '& int main(){
183 
184 ?MSG_ALL
185 
186 VAR e = httpLoad(ICON, "freebasic.net/sites/default/files/horse_original_r_0_0.gif", MIME_GIF)
187 IF e THEN ?"ICON error: " & *e & !" failed:\n" & ICON
188 
189 HTTP = !"HTTP/1.1 200 OK" _
190  & !"\r\nServer: NetToBac-Server" _
191  & !"\r\nAccept-Ranges: bytes" _
192  & !"\r\nVary: Accept-Encoding" _
193  & !"\r\nX-Content-Type-Options: nosniff" _
194  & !"\r\nContent-Type: text/html" _
195  & !"\r\nConnection: close" _
196  & !"\r\nContent-Length: "
197 
198  '& !"\r\nConnection: keep-alive" _
199  '& !"\r\nETag: ""2ffde1-25e6-51aea94fd5f28""" _
200  '& !"\r\nCache-Control: public, max-age=86400" _
201  '& !"\r\nDate: Fri, 30 Oct 2015 09:16:52 GMT" _
202  '& !"\r\nLast-Modified: Wed, 15 Jul 2015 14:15:07 GMT" _
203 
204 CHDIR(EXEPATH())
205 VAR fnam = "data/demo1.html", fnr = FREEFILE
206 IF OPEN(fnam FOR INPUT AS fnr) THEN
207  ?"Cannot open " & fnam
208 ELSE
209  HTML1 = STRING(LOF(fnr), 0)
210  GET #fnr, , HTML1
211  CLOSE #fnr
212 END IF
213 
214 fnam = "data/demo2.html"
215 fnr = FREEFILE
216 IF OPEN(fnam FOR INPUT AS fnr) THEN
217  ?"Cannot open " & fnam
218 ELSE
219  HTML2 = STRING(LOF(fnr), 0)
220  GET #fnr, , HTML2
221  CLOSE #fnr
222 END IF
223 
224 END doServer(3490)
225 
226 '& doServer();};
227