File: unix.server

package info (click to toggle)
jimtcl 0.81%2Bdfsg0-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 15,416 kB
  • sloc: ansic: 175,569; tcl: 5,456; sh: 4,814; cpp: 1,671; makefile: 269
file content (48 lines) | stat: -rw-r--r-- 1,038 bytes parent folder | download | duplicates (6)
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
# Example of a unix domain stream server which sends a response

file delete unix.tmp
set s [socket unix.server unix.tmp]

puts "Listening on [$s sockname]"

$s readable {
	# Clean up children
	wait -nohang 0
	set sock [$s accept]

	# Make this server forking so we can accept multiple
	# simultaneous connections
	if {[os.fork] == 0} {
		# We don't want the unix domain path to be deleted here
		$s close -nodelete

		$sock buffering line

		# Get the requests, one line at a time an evaluate
		while {[$sock gets buf] >= 0} {
			set buf [string trim $buf]
			if {$buf in {? help}} {
				set result "Enter any Tcl command to run in the server"
			} else {
				try {
					set result [eval $buf]
					set result [string map [list \\ \\\\ \n \\n \r \\r] $result]
				} on error {msg} {
					set result "Error: $buf => $msg"
				}
			}

			# Send the result back to where it came from
			$sock puts $result
		}
	}

	$sock close
}

# Handle signals so the socket is removed on exit
signal handle SIGINT SIGTERM

catch -signal {
	vwait done
}