File: qa-net

package info (click to toggle)
newlisp 10.7.5-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, forky, sid, trixie
  • size: 6,248 kB
  • sloc: ansic: 33,280; lisp: 4,181; sh: 609; makefile: 215
file content (176 lines) | stat: -rwxr-xr-x 5,078 bytes parent folder | download | duplicates (2)
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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
#!/usr/bin/env newlisp

; qa-net - test network routines for server mode IPv4
;
; tests: net-eval
; tests http mode of: load, save, read-file, write-file, delete-file
; 
; assumes newlisp executable in the current directory:
;     newlisp-x.x.x/
;
; usage to test on local host:
;
;        ./newlisp qa-net  
;
; usage to test on a remote host
; 
;        ./newlisp qa-net http://mysite.com:10001//home/test
; or 
;        ./newlisp qa-net http://localhost:4711//Users/Lutz/newlisp-8.9.8
;
; running this test on Win32/64
;
;        newlisp qa-net
;
; On Win32/64 this test may have timing issues, try running again.
; 
;

(delete-file "qa-junk.txt")
(when (file? "qa-junk.txt")
	(println ">>>>> Please remove file qa-junk.txt manually")
	(exit))

(println)
(println "Testing network API and server mode IPv4")

(when (not (or (file? "newlisp") (file? "newlisp.exe")))
	(println ">>>>> Need a newlisp executable in the current directory for qa-net")
	(exit)
)

(set 'start (time-of-day))

(println "Testing IPv4 networking functions")
(set 'targetURL (or 
	(main-args 2)
	(append "http://localhost:10001/" (real-path) "/qa-junk.txt")))

(replace "\\" targetURL "/") ; for Win32/64

(when (not (ends-with targetURL "/qa-junk.txt"))
	(set 'targetURL (append targetURL "/qa-junk.txt")))

(set 'host ((regex "http://(.*?):" targetURL) 3))
(set 'port (int ((regex "http://.*?:(\\d+)/" targetURL) 3)))
(set 'file-path ((regex "http://.*:\\d+/(.*)" targetURL) 3))


(println)
(println "target URL: " targetURL)

(println "host: " host)
(println "port: " port)
(println "path: " file-path)

; check if server is online or start it, if not
; start one on localhost if no URL was specified
; on the command line
(set 'connection (net-connect host port 1000))
(if (not connection)
	(begin
		(println "Starting server on localhost")
		(if (find ostype '("Windows" "OS/2"))
			(set 'pid (process (string "newlisp -c -d " port)))
			(set 'pid (process (string "./newlisp -c -d " port)))))
	(begin
		(println "Server already running ...")
		(net-close connection)))
	

(println "waiting for server ...")
(sleep 1000)

(if (net-connect host (+ port 1) 500)
	(println " >>>> net-connect -> ERROR")
	(println "net-connect to wrong port ->OK"))

(if (find "HTTP/1.0 404" (get-url (string "http://" host ":" port "/xyz.xyz")))
	(set 'result0 (println "get-url ->OK"))
	(println " >>>> get-url problem ->ERROR"))

; test short syntax normal mode
(if (=  (net-eval host port {(+ 3 4)} 1000) 7) 
	(set 'result1 (println "net-eval normal mode ->OK"))
	(println " >>>> net-eval poblem with normal mode ->ERROR"))

; test error reporting
(if (= (net-eval host port "(abc)") "\nERR: invalid function : (abc)\n")
	(set 'result2 (println "net-eval error reporting ->OK"))
	(println " >>>> net-eval problem with error reporting ->ERROR"))

; test saving to URL
(set 'key (uuid))
(set 'verify key)
(if (catch (save targetURL 'key) 'res)
	(set 'result3 (println "save to URL ->OK"))
	(println " >>>> save to URL ->ERROR"))

(when (find ostype '("Windows" "Cygwin"))
	(print "waiting on Windows for file to be unlocked .")
	(until (= (length (source 'key)) (first (file-info file-path)))
		(sleep 1000) 
		(print "."))
	(println))

; test loading from URL
(if (and
       (println "loading target URL: " targetURL)
       (catch (= (load targetURL) verify) 'result) 
       (= key verify))
       (set 'result4 (println "load from URL ->OK"))
	(begin
    	(println " >>>> load from URL ->ERROR OK on some Windows")
		(println result))
)

; test writing file to remote

; generate random binary data
(set 'content "")
(dotimes (i 100000)
	(write-buffer content (pack "c" (rand 255))))

; write content to remote URL
(if	(find "transferred" (print (write-file targetURL content)) )
	(set 'result5 (println "write-file to remote URL ->OK"))
	(println "write-file to remote URL ->ERROR"))

(when (find ostype '("Windows" "Cygwin"))
	(print "waiting on Windows for file to be unlocked .")
	(until (= 100000 (first (file-info file-path)))
		(sleep 1000) 
		(print "."))
	(println))

; read content from remote URL
(if (catch (= contents (read-file targetURL)) 'result)
    (set 'result6 (println "read-file from remote URL ->OK"))
    (begin
        (println " >>>> read-file from  remote URL ->ERROR OK on some Windows")
		(println result))
)

; delete file at remote URL
(if (not (find  ostype '("Windows"))) ; does not work on Windows when on the same machine
	(if (delete-file targetURL)
		(set 'result7 (println "delete-file from remote URL ->OK"))
		(println " >>>> delete-file from remote URL ->Error"))
	(set 'result7 true)
)

(when pid
	(println "destroy -> " pid " ->" (destroy pid)))

(println "\nduration -> " (- (time-of-day) start) " ms\n")

(if (and result0 result1 result2 result3 result4 result5 result6 result7 )
	(println ">>>>> Network eval and network file functions IPv4 SUCCESSFUL")
	(println ">>>>> PROBLEM in network eval and network file IPv4 functions")
)
(println)
(delete-file "qa-junk.txt")
(when (file? "qa-junk.txt")
	(println ">>>>> Please remove file qa-junk.txt manually"))

(exit)