Rev 681 | Rev 907 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | SVN | RSS feed
| Rev 681 | Rev 889 | ||
|---|---|---|---|
| Line 57... | Line 57... | ||
| 57 | $hubport = $tcpportarg; |
57 | $hubport = $tcpportarg; |
| 58 | } |
58 | } |
| 59 | 59 | ||
| 60 | $C2SSTARTSTR = 253; |
60 | $C2SSTARTSTR = 253; |
| 61 | $C2SENDSTR = 250; |
61 | $C2SENDSTR = 250; |
| - | 62 | $C2PINGSTR = 251; |
|
| 62 | 63 | ||
| 63 | ### create a tcp server ### |
64 | ### create a tcp server ### |
| 64 | $linelength=1000; |
65 | $linelength=1000; |
| 65 | &tcpServerInit; |
66 | &tcpServerInit; |
| 66 | $thr = threads->new(\&tcpServerThread); |
67 | $thr = threads->new(\&tcpServerThread); |
| Line 156... | Line 157... | ||
| 156 | 157 | ||
| 157 | ### Cut all leading chars that is not a start-char ### |
158 | ### Cut all leading chars that is not a start-char ### |
| 158 | for ($i = 0; $i < length($input); $i++) { |
159 | for ($i = 0; $i < length($input); $i++) { |
| 159 | if (ord(substr($input, $i, 1)) == $C2SSTARTSTR) { |
160 | if (ord(substr($input, $i, 1)) == $C2SSTARTSTR) { |
| 160 | $input = substr($input, $i); |
161 | $input = substr($input, $i); |
| - | 162 | $output = $input; |
|
| - | 163 | #print "debug: cutting character\n"; |
|
| 161 | break; |
164 | break; |
| - | 165 | } |
|
| - | 166 | if (ord(substr($input, $i, 1)) == $C2PINGSTR) { |
|
| - | 167 | print "Got pong from hardware\n"; |
|
| - | 168 | $input = substr($input, $i+1); |
|
| - | 169 | $output = $input; |
|
| 162 | } |
170 | } |
| 163 | } |
171 | } |
| 164 | ### Check for possible complete packets ### |
172 | ### Check for possible complete packets ### |
| 165 | for ($i = 0; $i < length($input)-16; $i++) { |
173 | for ($i = 0; $i < length($input)-16; $i++) { |
| 166 | my $newmsg = substr($input, $i, 17); |
174 | my $newmsg = substr($input, $i, 17); |
| Line 196... | Line 204... | ||
| 196 | $serialPort->handshake("none") || die "failed setting handshake"; |
204 | $serialPort->handshake("none") || die "failed setting handshake"; |
| 197 | $serialPort->write_settings || die "no settings"; |
205 | $serialPort->write_settings || die "no settings"; |
| 198 | 206 | ||
| 199 | $serialPort->read_char_time(0); # don't wait for each character |
207 | $serialPort->read_char_time(0); # don't wait for each character |
| 200 | $serialPort->read_const_time(1000); # 1 second per unfulfilled "read" call |
208 | $serialPort->read_const_time(1000); # 1 second per unfulfilled "read" call |
| - | 209 | ||
| - | 210 | print "Testing connection to hardware: ping (hardware should answer with a pong)\n"; |
|
| - | 211 | serialConnSend(chr($C2PINGSTR)); |
|
| 201 | 212 | ||
| 202 | ### create a connection between the hardware and the tcp-server ### |
213 | ### create a connection between the hardware and the tcp-server ### |
| 203 | &hardwareConnInit; |
214 | &hardwareConnInit; |
| 204 | $hardwareSendFunction = "serialConnSend"; ### set up callback for a 'send data' function |
215 | $hardwareSendFunction = "serialConnSend"; ### set up callback for a 'send data' function |
| 205 | $thr = threads->new(\&hardwareConnThread); |
216 | $thr = threads->new(\&hardwareConnThread); |
| Line 252... | Line 263... | ||
| 252 | 263 | ||
| 253 | } |
264 | } |
| 254 | 265 | ||
| 255 | sub udpServerSend { |
266 | sub udpServerSend { |
| 256 | print $udpCsocket $_[0]; |
267 | print $udpCsocket $_[0]; |
| 257 | } |
268 | } |
| 258 | 269 | ||
| 259 | ##################### TCP HUB ############################ |
270 | ##################### TCP HUB ############################ |
| 260 | sub tcpServerThread { |
271 | sub tcpServerThread { |
| 261 | while(@ready = $tcpSselect->can_read) { |
272 | while(@ready = $tcpSselect->can_read) { |
| 262 | for $tcpSsocket (@ready) { |
273 | for $tcpSsocket (@ready) { |
| 263 | if($tcpSsocket == $tcpSlisten) { |
274 | if($tcpSsocket == $tcpSlisten) { |
| Line 347... | Line 358... | ||
| 347 | #line should be parsed somewhat here, check PKT, AUT and so on |
358 | #line should be parsed somewhat here, check PKT, AUT and so on |
| 348 | $testErr = 0; |
359 | $testErr = 0; |
| 349 | if (length($input) < 16) { |
360 | if (length($input) < 16) { |
| 350 | $testErr = 1; |
361 | $testErr = 1; |
| 351 | if ($messages!=1) {print "Packet was malformed, not long enough\n";} |
362 | if ($messages!=1) {print "Packet was malformed, not long enough\n";} |
| 352 | } |
363 | } |
| 353 | if ($testErr == 0 && substr($input, 0, 4) != "PKT ") { |
364 | if ($testErr == 0 && substr($input, 0, 4) != "PKT ") { |
| 354 | $testErr = 1; |
365 | $testErr = 1; |
| 355 | if ($messages!=1) {print "Packet was malformed, should start with PKT\n";} |
366 | if ($messages!=1) {print "Packet was malformed, should start with PKT\n";} |
| 356 | } |
367 | } |
| 357 | #if (substr($line, 12, 1) != " " || substr($line, 14, 1) != " ") { |
368 | #if (substr($line, 12, 1) != " " || substr($line, 14, 1) != " ") { |
| 358 | # $testErr = 1; |
369 | # $testErr = 1; |
| 359 | # print "Packet was malformed, spaces not in the correct place\n"; |
370 | # print "Packet was malformed, spaces not in the correct place\n"; |
| 360 | #} |
371 | #} |
| 361 | @splitinput = split(/ +/, $input); |
372 | @splitinput = split(/ +/, $input); |
| 362 | $inputarrlen = @splitinput; |
373 | $inputarrlen = @splitinput; |
| 363 | if ($testErr == 0 && ($inputarrlen < 4 || $inputarrlen > 12)) { |
374 | if ($testErr == 0 && ($inputarrlen < 4 || $inputarrlen > 12)) { |
| 364 | $testErr = 1; |
375 | $testErr = 1; |
| 365 | if ($messages!=1) {print "Packet was malformed, to many or to few parts\n";} |
376 | if ($messages!=1) {print "Packet was malformed, to many or to few parts\n";} |
| 366 | } |
377 | } |
| 367 | if ($testErr == 0 && length($splitinput[1]) != 8) { |
378 | if ($testErr == 0 && length($splitinput[1]) != 8) { |
| 368 | $testErr = 1; |
379 | $testErr = 1; |
| 369 | if ($messages!=1) {print "Packet was malformed, id part must be 8 digits (padded with zeros)\n";} |
380 | if ($messages!=1) {print "Packet was malformed, id part must be 8 digits (padded with zeros)\n";} |
| 370 | } |
381 | } |
| 371 | if ($testErr == 0 && length($splitinput[2]) != 1) { |
382 | if ($testErr == 0 && length($splitinput[2]) != 1) { |
| 372 | $testErr = 1; |
383 | $testErr = 1; |
| 373 | if ($messages!=1) {print "Packet was malformed, ext part must be 1 digit\n";} |
384 | if ($messages!=1) {print "Packet was malformed, ext part must be 1 digit\n";} |
| 374 | } |
385 | } |
| 375 | if ($testErr == 0 && length($splitinput[3]) != 1) { |
386 | if ($testErr == 0 && length($splitinput[3]) != 1) { |
| 376 | $testErr = 1; |
387 | $testErr = 1; |
| 377 | if ($messages!=1) {print "Packet was malformed, rtr part must be 1 digit\n";} |
388 | if ($messages!=1) {print "Packet was malformed, rtr part must be 1 digit\n";} |
| 378 | } |
389 | } |
| 379 | for ($i = 4; $i < $inputarrlen; $i++) { |
390 | for ($i = 4; $i < $inputarrlen; $i++) { |
| 380 | if ($testErr == 0 && length($splitinput[$i]) != 2) { |
391 | if ($testErr == 0 && length($splitinput[$i]) != 2) { |
| 381 | $testErr = 1; |
392 | $testErr = 1; |
| 382 | if ($messages!=1) {print "Packet was malformed, data parts must be 2 digits (padded with zero)\n";} |
393 | if ($messages!=1) {print "Packet was malformed, data parts must be 2 digits (padded with zero)\n";} |
| 383 | } |
394 | } |
| 384 | } |
395 | } |
| 385 | $checkstrlen = length($input)-4; |
396 | $checkstrlen = length($input)-4; |
| 386 | $checkstr = substr($input, 4, $checkstrlen); |
397 | $checkstr = substr($input, 4, $checkstrlen); |
| 387 | if ($testErr == 0 && $checkstr !~ m/^[0-9a-fA-F ]*$/) { |
398 | if ($testErr == 0 && $checkstr !~ m/^[0-9a-fA-F ]*$/) { |
| 388 | $testErr = 1; |
399 | $testErr = 1; |
| 389 | if ($messages!=1) {print "Packet was malformed, not hex\n";} |
400 | if ($messages!=1) {print "Packet was malformed, not hex\n";} |
| Line 409... | Line 420... | ||
| 409 | for ($i = 0; $i < $dl; $i++) { |
420 | for ($i = 0; $i < $dl; $i++) { |
| 410 | $data = ord(substr($input, 8+$i, 1)); |
421 | $data = ord(substr($input, 8+$i, 1)); |
| 411 | $output .= sprintf " %02x", $data; |
422 | $output .= sprintf " %02x", $data; |
| 412 | } |
423 | } |
| 413 | $_[1] = "PKT ".$output; |
424 | $_[1] = "PKT ".$output; |
| - | 425 | } else { |
|
| - | 426 | #print "debug: incorrect ext, rtr or dl\n"; |
|
| - | 427 | ||
| 414 | } |
428 | } |
| - | 429 | } else { |
|
| - | 430 | #print "debug: incorrect boundaries\n"; |
|
| - | 431 | ||
| 415 | } |
432 | } |
| 416 | } |
433 | } |
| 417 | 434 | ||
| 418 | #this function should parse $_[0] (string) and save in $_[1] as can2serial-data |
435 | #this function should parse $_[0] (string) and save in $_[1] as can2serial-data |
| 419 | sub stringToc2s { |
436 | sub stringToc2s { |