libssock.kl

-- Software License Agreement (BSD License)
--
-- Copyright (c) 2012-2015, TU Delft Robotics Institute
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions
-- are met:
--
--  * Redistributions of source code must retain the above copyright
--    notice, this list of conditions and the following disclaimer.
--  * Redistributions in binary form must reproduce the above
--    copyright notice, this list of conditions and the following
--    disclaimer in the documentation and/or other materials provided
--    with the distribution.
--  * Neither the name of the TU Delft Robotics Institute nor the names 
--    of its contributors may be used to endorse or promote products 
--    derived from this software without specific prior written 
--    permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-- COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-- POSSIBILITY OF SUCH DAMAGE.


PROGRAM libssock
--------------------------------------------------------------------------------
-- 
-- Convenience wrapper around the KAREL Socket Programming extensions. Only
-- works for Server TAGs right now.
-- 
-- See also KAREL Reference Manual, MARRC75KR07091E Rev C, chap. 11
-- 
-- 
-- author: G.A. vd. Hoorn (TU Delft Robotics Institute)
-- 
--------------------------------------------------------------------------------
%ALPHABETIZE
%COMMENT = 'ROS//r1'
%NOBUSYLAMP
%NOLOCKGROUP
%NOPAUSE = COMMAND + TPENABLE + ERROR




--------------------------------------------------------------------------------
-- 
-- local types & constants
-- 
--------------------------------------------------------------------------------
%INCLUDE include\libssock.th




--------------------------------------------------------------------------------
-- 
-- local routine prototypes
-- 
--------------------------------------------------------------------------------
%INCLUDE include\libssock.h




--------------------------------------------------------------------------------
-- 
-- Empty body
-- 
--------------------------------------------------------------------------------
BEGIN
END libssock




ROUTINE ssock_ping
VAR
	stat__ : INTEGER
BEGIN
	MSG_PING(host, stat__)
	RETURN (-stat__)
END ssock_ping




ROUTINE ssock_ctor
VAR
	tmp_str__   : STRING[1] -- temp string for tag_nr to str conversion
	entry__     : INTEGER   -- dummy var for set_var
	tag_state__ : INTEGER   -- TAG state
BEGIN
	-- setup instance variables
	this.connected_ = FALSE
	this.status_    = 0
	this.port_      = tcp_port
	this.tag_idx_   = tag_idx
	this.tag_str_   = ''
	this.hcfg_str_  = ''

	-- check
	IF (this.tag_idx_ < 1) OR (this.tag_idx_ > 8) THEN
		-- cannot open TAGs that don't exist
		RETURN (S_OPEN_ERR)
	ENDIF

	-- construct server_port variable string (ascii 'trick')
	tmp_str__ = CHR(this.tag_idx_ + ORD('0', 1))

	-- and set system variable
	this.hcfg_str_ = '$HOSTS_CFG[' + tmp_str__ + ']'

	-- construct server tag string
	this.tag_str_ = 'S' + tmp_str__ + ':'

	-- check state of tag, make sure it is STARTED
	GET_VAR(entry__, '*SYSTEM*', this.hcfg_str_ + '.$STATE', tag_state__, this.status_)
	IF (this.status_ <> 0) OR (tag_state__ <> TAG_STARTED) THEN
		-- TAG config not correct, or couldn't read it
		RETURN (TAG_CONF_ERR)
	ENDIF

	-- set port of TAG
	SET_VAR(entry__, '*SYSTEM*', this.hcfg_str_ + '.$SERVER_PORT', this.port_, this.status_)
	IF this.status_ <> 0 THEN
		-- couldn't update TAG config
		RETURN (TAG_CONF_ERR)
	ENDIF

	-- done
	RETURN (-this.status_)
END ssock_ctor




ROUTINE ssock_dump
BEGIN
	WRITE fd('Sock instance:', CR, &
			' connected :', this.connected_, CR, &
			' port      :', this.port_, CR, &
			' tag_idx   :', this.tag_idx_, CR, &
			' tag_str   : ', this.tag_str_, CR, &
			' hcfg_str  : ', this.hcfg_str_, CR)
END ssock_dump




ROUTINE ssock_accept
VAR
	stat__ : INTEGER
BEGIN
	stat__ = 0
	IF this.connected_ THEN
		RETURN (S_ACPT_ERR)
	ENDIF

	-- msg_connect only returns after a client connects to the port
	MSG_CONNECT(this.tag_str_, stat__)

	IF stat__ = 0 THEN
		this.connected_ = TRUE
	ENDIF

	RETURN (-stat__)
END ssock_accept




ROUTINE ssock_dconn
BEGIN
	IF this.connected_ = FALSE THEN
		RETURN (S_NOTCON_ERR)
	ENDIF

	-- use other routine
	RETURN (ssock_dconnf(this))
END ssock_dconn




ROUTINE ssock_dconnf
VAR
	stat__ : INTEGER
BEGIN
	stat__ = 0
	MSG_DISCO(this.tag_str_, stat__)

	this.connected_ = FALSE

	RETURN (-stat__)
END ssock_dconnf




ROUTINE ssock_ofd
VAR
	tmp__  : STRING[3]
	stat__ : INTEGER
BEGIN
	IF this.connected_ = FALSE THEN
		RETURN (S_NOTCON_ERR)
	ENDIF

	-- TODO: why is this temporary variable necessary?
	tmp__ = this.tag_str_
	OPEN FILE fd(mode, tmp__)

	stat__ = IO_STATUS(fd)
	RETURN (-stat__)
END ssock_ofd




ROUTINE ssock_cfd
VAR
	stat__ : INTEGER
BEGIN
	IF this.connected_ = FALSE THEN
		RETURN (S_NOTCON_ERR)
	ENDIF

	-- close file desc
	CLOSE FILE fd

	-- according to Karel Ref Man, A.4.12, this will always return 0
	stat__ = IO_STATUS(fd)
	RETURN (-stat__)
END ssock_cfd




ROUTINE ssock_accpt2
VAR
	stat__ : INTEGER
BEGIN
	stat__ = 0
	-- use other routine
	stat__ = ssock_accept(this)

	-- make sure it succeeded
	IF stat__ <> 0 THEN
		-- stat already < 0 from ssock_accept
		RETURN (stat__)
	ENDIF

	-- now open fd, read / write
	stat__ = ssock_ofd(this, fd, 'RW')

	-- done (stat already < 0 from ssock_ofd)
	RETURN (stat__)
END ssock_accpt2




ROUTINE ssock_dconn2
VAR
	stat__ : INTEGER
BEGIN
	stat__ = 0
	IF this.connected_ = FALSE THEN
		RETURN (S_NOTCON_ERR)
	ENDIF

	-- close fd first
	-- TODO: fail on failure to close fd?
	stat__ = ssock_cfd(this, fd)

	-- now socket
	MSG_DISCO(this.tag_str_, stat__)

	this.connected_ = FALSE

	-- done
	RETURN (-stat__)
END ssock_dconn2