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
src
bas
example_server.bas
Generated on Wed Oct 10 2018 16:19:46 for nettobac by
1.8.11