|
The following sample program is written for VAX-VMS Fortran and prints onto the screen a list
of the DAC and ADC values of all devices (command = RALL) of a given secondary beam line.
In order to run this sample program from a VAX-VMS host you first have to
replace in listing 1 the SERVER and PORT expressions by those valid for your
server. Then compile the subroutine package coded in C (Listing 2) and link
its object file with the compiled Fortran sample program (Listing 1). The compiler
and linker directives are given in Listing 3.
Note 1: VAX FORTRAN treats CHARACTERs as so called descriptors (DESC)
which are nothing else than structures. (The string part of the DESC structure
is not zero-terminated but filled up with trailing blanks.)
Note 2: All parameters in Fortran subroutines are usually transferred
by reference (as pointers).
Note 3: Porting the code to Linux should not cause any major problems.
Listing 1: TEST.FOR
===================
Program Test
C
character*15 SERVER
character*100 COMMAND
character*1000 BUFFER
c
integer PORT
integer SOCKET
integer TCPOpen
integer TCPClose
integer TCPTransfer
c
SERVER = 'MyPC' ! use the area's server name
PORT = 12345 ! use the area's port number
c
SOCKET = TCPOpen(SERVER,PORT)
if (SOCKET .NE. -1) THEN
COMMAND = 'RALL'
icount = TCPTransfer(SOCKET,COMMAND,BUFFER)
if (icount .NE. -1) call Print(BUFFER)
iret = TCPClose(SOCKET)
else
call exit
endif
c
end
subroutine Print(buffer)
c
character*(*) buffer
c
jpos = 1
jbeg = 1
50 continue
if (buffer(jpos:jpos) .eq. char(10)) then ! search for \n
write(6,*) buffer(jbeg:jpos-1)
jbeg = jpos + 1
endif
jpos = jpos + 1
if (jpos .ge. 1000) go to 100
go to 50
c
100 return
end
Listing 2: fsubs.c
==================
/*
TCP/IP subroutine package for VAX Fotran
*/
#include <types.h>
#include <socket.h>
#include <in.h>
#include <netdb.h>
#include <stdio.h>
#include <errno.h>
#include <string.h>
#define MAXLEN 2048 /* max command buffer length */
#define BACKLOG 5 /* max outstanding connections */
#define FLAGS 0 /* flags argument, must be zero */
#define closesocket close
#define SOCKET int
typedef struct
{
unsigned short length;
unsigned char type;
unsigned char code;
char *pointer;
} DESC;
typedef struct sockaddr *LPSOCKADDR;
int TCPOpen(DESC *pserver, int *pport)
{
int status;
int namelength;
int shutdown_required = 0;
char localhost_s[MAXLEN];
char remothost_s[MAXLEN];
struct sockaddr_in l_socket_s;
struct sockaddr_in r_socket_s;
struct hostent *localhost_p;
struct hostent *remothost_p;
SOCKET l_socket;
char server[MAXLEN];
short int port;
int i;
/* Interface Fortran -> C */
strncpy(server,pserver->pointer,pserver->length);
for (i=0; i<pserver->length; i++)
if (server[pserver->length-i-1] != ' ')
break;
server[pserver->length-i] = '\0';
port = *pport;
/* Create a socket */
l_socket = socket ( AF_INET, SOCK_STREAM, 0 );
if ( l_socket == -1 )
{
printf ("** Error Creating Socket **\n");
return -1;
}
/* Get hostname */
gethostname(localhost_s,sizeof(localhost_s));
localhost_p = gethostbyname ( localhost_s );
if ( localhost_p == NULL )
{
printf ("** Cannot get hostaddress of %s **\n",localhost_s);
return -1;
}
/* bind socket to port */
l_socket_s.sin_family = AF_INET;
l_socket_s.sin_port = htons ( 0 );
l_socket_s.sin_addr.s_addr = 0;
memcpy((char*)&(l_socket_s.sin_addr), localhost_p->h_addr, localhost_p->h_length);
status = bind ( l_socket, (LPSOCKADDR)&l_socket_s, sizeof(l_socket_s));
if ( status == -1 )
{
printf ("** Error Binding Socket, errno = %d **\n",errno);
shutdown ( l_socket , 2 );
return -1;
}
/* Get Server name */
strcpy(remothost_s,server);
remothost_p = gethostbyname ( remothost_s );
if ( remothost_p == NULL )
{
printf ("** Cannot get server address %s **\n",remothost_s);
return -1;
}
/* Connect to Server socket */
r_socket_s.sin_family = AF_INET;
r_socket_s.sin_port = htons ( (unsigned short)port );
r_socket_s.sin_addr.s_addr = *(unsigned long *) *(remothost_p->h_addr_list);
namelength = sizeof ( r_socket_s );
status = connect ( l_socket, (LPSOCKADDR)&r_socket_s, namelength );
if ( status == -1)
{
printf ("** Error connecting to Server **\n");
shutdown ( l_socket , 2 );
return -1;
}
return (l_socket);
}
int TCPClose(SOCKET *socket)
{
int retval;
SOCKET l_socket = *socket;
retval = closesocket( l_socket );
return retval;
}
int TCPTransfer(SOCKET *socket, DESC *command, DESC *buffer)
{
int i, z, status;
int count;
struct timeval timeout;
fd_set readfds;
int msecs = 4000;
SOCKET l_socket;
char command_s[MAXLEN];
char r_buffer[MAXLEN];
char *ptr;
/* Interface Fortran -> C */
l_socket = *socket;
strncpy(command_s,command->pointer,command->length);
for (i=0; i<command->length; i++)
if (command_s[command->length-i-1] != ' ')
break;
command_s[command->length-i] = '\0';
count = send ( l_socket, command_s, strlen(command_s) + 1, FLAGS );
if ( count == -1)
{
printf ("** Error sending data **\n");
return -1;
}
z = 0;
while(1)
{
if (msecs > 0)
{
FD_ZERO(&readfds);
FD_SET(l_socket,&readfds);
timeout.tv_sec = msecs / 1000;
timeout.tv_usec = (msecs % 1000) * 1000;
status = select(FD_SETSIZE, &readfds, NULL, NULL, &timeout);
if (status == -1)
{
printf ("** Error while selecting **\n");
return 0;
}
if (!FD_ISSET(l_socket,&readfds))
{
printf ("** Timeout while selecting **\n");
r_buffer[z] = '\0'; // terminate it by adding a '\0'
z++;
break;
}
}
count = recv ( l_socket, &r_buffer[z], MAXLEN, FLAGS );
if ( count == -1 )
{
printf ("** Error receiving answer **\n");
return -1;
}
else
z += count;
if (r_buffer[z-1] == '\0') // termination has arrived
break;
}
/* Interface C -> Fortran */
strncpy(buffer->pointer,r_buffer,z-1);
ptr = (char *)(buffer->pointer + z-1);
*ptr++ = '\n'; /* terminate with LF */
memset(ptr,' ',buffer->length-z); /* fill rest with blanks */
return z;
}
Listing 3: Compilation and Linking
==================================
$cc/vaxc fsubs.c
$fortran test.for
$link test + fsubs + sys$library:ucx$ipc/lib + sys$library:vaxcrtl/lib
Back to:About Client/Server Dialog
Last updated by Urs Rohrer on 10-Feb-2005