' INTER PROCESS MESSAGING - API
public ipm_close()
public ipm_open()
public ipm_read()
public ipm_write()

public ipm_accept()
public ipm_end_accept() '

global open_queue()
global close_queue()

external message_do()
external message_alive()

main
	"@(#)ipcserv.pf3	3.2 - 96/10/08" '	SID
end main

' Returns 0 for OK, or errno
' ****************************************************
function ipm_accept(#key,VP_queue)
' ****************************************************
local #msg_type #value $queue_id #queue_id

	if #key = 0
		#key = 1621
	end if

	clearerror
	message_alive()
	if lerror
		message "Messaging library must be open"
		return -1
	end if

	#value = open_queue(#key,varptr(#queue_id))
	if #value
		return #value
	end if
	$queue_id = str(#queue_id)

	#key = #key + 1
	#value = open_queue(#key,varptr(#queue_id))
	if #value
		close_queue( val($queue_id) )
		return #value
	end if
	$queue_id = $queue_id & str(#queue_id)
	writeptr(VP_queue,$queue_id)

	return #value
end function

' Returns 0 for OK, or errno
' ****************************************************
function open_queue(#key,VP_queue)
' ****************************************************
local #value #queue_id #error
	#error = sysvar($_error)
	error off

	smartpoke $_unixerr 0
	unix msg-open new #key id #queue_id
	smartpeek $_unixerr #value

	if #value <> 0
		if #value = 17
			'message "Could not open new message. errno = "|str(#value)
			'message "17 = Unique key already exists attempting to open as OLD-OR-NEW"

			smartpoke $_unixerr 0
			unix msg-open old-or-new #key id #queue_id
			smartpeek $_unixerr #value

		end if
	end if
	if #error
		error on
	end if
	if #value
		message_do("unix error",#value,"Error opening IPC queue.  Key="|str(#key),0)
	else
		writeptr(VP_queue,#queue_id)
	end if
	return #value
end function

' ****************************************************
function ipm_end_accept(#queue_id)
' ****************************************************
local #value #error
	#error = sysvar($_error)
	error off
	smartpoke $_unixerr 0
	unix msg-remove #queue_id
	smartpeek $_unixerr #value
	if #error
		error on
	end if
	if #value
		message_do("unix error",#value,"Error closing IPC",0)
	end if
end function

' ****************************************************
function close_queue(#queue_id)
' ****************************************************
local #value #error
	#error = sysvar($_error)
	error off
	clearerror
	smartpoke $_unixerr 0
	unix msg-remove #queue_id
	smartpeek $_unixerr #value
	if #error
		error on
	end if
	if #value and lerror
		message_do("unix error",#value,"Error closing queue",0)
	end if
end function

' ****************************************************
function ipm_open($queue_id,VP_pid,#block,#timeout,#delay)
' ****************************************************
local #time $str #msg_type #value #queue_id #error
local #retval
local $strs[10]
	#queue_id = val(group($queue_id,1))
	sysvar($_lastkey,0)
	#time = seconds(now)
	#msg_type = -0xFFFFF
	#error = sysvar($_error)
	$strs[1]="IPC Open - Waiting for message from smrtpipe"
	$strs[2]=""
	if #block
		$strs[3]="In WAIT mode - Kill process or run command '???' to stop"
	else
		$strs[3]="In NO-WAIT mode - Press ESC to abort server"
	end if
	$strs[4]=""
	$strs[5]="Queue IDs="|$queue_id
	$strs[6]=0
	message_do("status message",0,"",arrayptr($strs[1]))
	error off
	while true
		clearerror
		smartpoke $_unixerr 0
		if #block
			unix msg-receive #queue_id into $str type #msg_type wait
		else
			unix msg-receive #queue_id into $str type #msg_type no-wait
		end if
		smartpeek $_unixerr #value
		if lerror=0
			if left($str,4)="PID="
				writeptr(VP_pid,val(mid($str,5)))
				return 1
			else
				message_do("unix error",#value,"Error conversing with IPC queue.  Queue="|$queue_id,0)
				continue while
			end if
  		end if
		if #timeout
			if seconds(now)>#time+#timeout
				return 0
			end if
		end if
		if nextkey
			if inchar={esc}
				return 0
			end if
		end if
		if #delay
			wait #delay
		end if
		if sysvar($_lastkey)={esc}
			return 0
		end if
	end while
label out
	if #error
		error on
	end if
	return #retval
end function

global $last_queue
' ****************************************************
function ipm_read($queue_id,#pid,VP_str,#block,#timeout,#delay)
' ****************************************************
local #time $str #msg_type #value #queue_id $strs[10]

	#queue_id = val(group($queue_id,1))
	#time = seconds(now)
	error off
	if $last_queue<>$queue_id
		$strs[1]="IPC READ - Waiting for message from smrtpipe"
		$strs[2]=""
		if #block
			$strs[3]="In WAIT mode - Kill process or run command '???' to stop"
		else
			$strs[3]="In NO-WAIT mode - Press ESC to abort server"
		end if
		$strs[3]=0
		message_do("status message",0,"",arrayptr($strs[1]))
	end if
	$last_queue=$queue_id

	while true
		clearerror
		smartpoke $_unixerr 0
		$str = ""
		if #block
			unix msg-receive #queue_id into $str type #pid wait
		else
			unix msg-receive #queue_id into $str type #pid no-wait
		end if
		smartpeek $_unixerr #value
		if lerror=0 or len($str)
			writeptr(VP_str,$str)
			return 1
		else
			message_do("unix error",#value,"Error conversing with IPC queue.  Queue="|$queue_id,0)
			continue while
  		end if
		if #timeout
			if seconds(now)>#time+#timeout
				return 0
			end if
		end if
		if nextkey
			if inchar={esc}
				return 0
			end if
		end if
		if #delay
			wait #delay
		end if
	end while
end function

' ****************************************************
function ipm_write($queue_id, #pid, $str)
' ****************************************************
local #queue_id
	#queue_id = val(group($queue_id,2))
	unix msg-send #queue_id from $str length len($str)+1 type #pid wait
end function

' ****************************************************
function ipm_close($queue_id, #pid)
' ****************************************************
	ipm_write($queue_id, #pid,"!"|str(#pid))
end function