[OpenVMS, GNV, Telnet] Alternate DCL image using a Telnet device


PRODUCT:    HP C Version 7.2-022 or above
            HP TCP/IP Services Version V5.6 - ECO 4 or above
            HP I64VMS GNV V2.1-3


OP/SYS:     OpenVMS Version 8.3-1H1


COMPONENT:  GNU:[BIN]DCL.EXE


SOURCE:     Philippe Vouters
            Fontainebleau/France


HIGH QUALITY MOBILES+TABLETS:  http://android-land.fr


OVERVIEW:

GNU:[BIN]DCL.EXE, a GNV DCL wrapper, is based upon mailboxes to communicate
with the spawned subprocess. This brings a number of problems because of the
nature of mailboxes which are record oriented. One of which occurs when a
spawned subprocess performs a write to SYS$OUTPUT with no CRLF such as a printf
with no ending \n followed by fflush. In this case the cursor comes up on the 
beginning of next line. A second problem is that you cannot 
$ dcl set terminal/inquire on a mailbox. A third problem is that you cannot 
$ dcl inquire var "prompt " because the command argument is not specified in 
the lib$spawn call.

This program attempts to solve all these problems by using a socket device
associated to a Telnet terminal device. The biggest problem is that it may not
be portable with other TCP/IP for OpenVMS stacks such as shipped by Process
Software or Multinet. CTRL-Z and CTRL-C are handled by the code. The OpenVMS 
recommended CTRL-Y/CONTINUE and CTRL-Y/EXIT are also handled.

Because this program associates a TCP/IP socket with a Telnet terminal device
which has all the features of a real terminal, you become almost as limited in
using OpenVMS as if using an interactive session.


*** CAUTION ***

This sample program has been tested using HP C V7.2-022 and HP TCP/IP Services
V5.6 - ECO 4 on OpenVMS IA64 V8.3-1H1. However, we cannot guarantee its 
effectiveness because of the possibility of error in transmitting or 
implementing it. It is meant to be used as a template for writing your own 
program, and may require modification for use on your system. 


PROGRAM NOTES:

Extract the codes hereafter to dcl.c, tn.h and tn.c. To compile/link the codes,
perform the following commands:

        $ cc/reentrancy=(multithread) dcl
        $ cc/reentrancy=(multithread) tn+sys$library:sys$lib_c/lib
        $ link/threads=(upcalls,multiple) dcl,tn

Then:

        $ DEFINE DCL$PATH <default directory>
        $ dcl <VMS command>

For Java programs:

        $ DEFINE VAXC$PATH <default directory>
        $ java "Myprog" dcl <VMS command>

An example of Myprog.java is Testexec2.java viewable at:
../tima/OpenVMS-Java-Executing_DCL_commands.html


SOME OUTPUT EXAMPLES:

$ define DCL$PATH []
$ dcl type son.c
#include <stdio.h>
#include <unistd.h>
#include <stdlib.h>

void main(int argc, char **argv){
 int i;
 char buf[100];

#ifdef SETVBUF
  setvbuf(stdout, NULL, _IONBF, 0);
  setvbuf(stdin, NULL, _IONBF, 0);
#endif
 for (i=0; i < argc; i++) {
      printf ("argv[%1d]=%s\n",i,argv[i]);
#ifndef SETVBUF
      fflush(stdout);
#endif
 }
 fputs("Flush ? [Y/N] : ",stdout);
#ifndef SETVBUF
 fflush(stdout);
#endif
 sleep(1);
 if (fgets(buf, sizeof(buf), stdin) == NULL){
     perror("fgets");
     exit(EXIT_FAILURE);
 }
 if (buf[0] == 'Y'){
    printf ("Son started. This message is flushed. Next message is not\n");
#ifndef SETVBUF
    fflush(stdout);
#endif
 } 
 printf("Message not flushed. ");
#ifdef SETVBUF
 printf("stdout is unbuffered (setvbuf call). It appears immediately\n");
#else
 printf("It appears at son's exit\n");
#endif
 sleep(10);
 exit(0);
}
  Process PV_31892 logged out at 17-JUN-2011 20:29:05.31
$ dcl run son 

argv[0]=dsa0:[users.][pv]son.exe;14
Flush ? [Y/N] : YSon started. This message is flushed. Next message is not
Message not flushed. It appears at son's exit
  Process PV_32444 logged out at 17-JUN-2011 20:30:40.99
$ dcl inquire name """"What is your name ?""""
what is your name ?: vouters
  Process PV_40090 logged out at 17-JUN-2011 20:31:49.85


PROGRAM:

************
* dcl.c
************
/*
 *       Copyright (C) 2011 by Philippe.Vouters@laposte.net
 *
 *   This program is free software: you can redistribute it and/or modify
 *   it under the terms of the GNU General Public License as published by the
 *   Free Software Foundation, either version 3 of the License, or
 *   any later version.
 *
 *   This program is distributed in the hope that it will be useful,
 *   but WITHOUT ANY WARRANTY; without even the implied warranty of
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *   GNU General Public License for more details.
 *
 *   You should have received a copy of the GNU General Public License
 *   along with this program.  If not, see <http://www.gnu.org/licenses/>;.
 */
/*
 * This program creates an anonymous TCP/IP socket and a connected to
 * it socket used for associating with a TNA device that it creates. It then
 * spawns the command using a temporary file as input to SPAWN/COMMAND and
 * the created TNA device as SPAWN/INPUT and SPAWN/OUTPUT. It then awaits for
 * the subprocess completion. This program handles CTRL-Z cleanly sending
 * CTRL-Z to the subprocess and CTRL-C which is equivalent to sending a SIGINT
 * signal. It also cleanly handles CRTL-Y/CONTINUE and CTRL-Y/EXIT.
 */
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <signal.h>
#include <setjmp.h>
#include <ctype.h>
#include <unixio.h>
#include <unistd.h>
#include <socket.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <arpa/inet.h>
#include <netinet/in.h>
#include <pthread.h>
#include <efndef.h>
#include <iodef.h>
#include <dvidef.h>
#include <clidef.h>
#include <climsgdef.h>
#include <ttdef.h>
#include <tt2def.h>
#include <trmdef.h>
#include <ssdef.h>
#include <descrip.h>
#include <devdef.h>
#include <starlet.h>
#include <lib$routines.h>
#include <libclidef.h>
#include "tn.h"

#define MAX_BUF_VMS 256
#ifndef TNA_DEVICE
#define TNA_DEVICE "TNA"
#endif

#ifndef FD_SET
#ifndef __DECC
#ifndef FD_SETSIZE
#define FD_SETSIZE 64
#endif
struct fd_set_struct {u_char fds_bits[FD_SETSIZE/8];};
typedef struct fd_set_struct fd_set;
#endif
#define NFDBITS         sizeof(fd_set)/sizeof (u_char)
#ifndef FD_SETSIZE
#define FD_SETSIZE      NFDBITS
#endif
#define FD_SET(n, p)    ((p)->fds_bits[(n)/NFDBITS] |= (1 << ((n) % NFDBITS)))
#define FD_CLR(n, p)    ((p)->fds_bits[(n)/NFDBITS] &= ~(1 << ((n) % NFDBITS)))
#define FD_ISSET(n, p)  ((p)->fds_bits[(n)/NFDBITS] & (1 << ((n) % NFDBITS)))
#define FD_ZERO(p)      memset((char *)(p), 0,sizeof(*(p)))
#endif

#define DEVICE_NAME_LENGTH 64
#define MAXMSG  1024

#define CTRL_Z 26
#define CTRL_C 3
#define CTRL_Y 25
#define CTRL_O 15
#define CTRL_X 24
#define CTRL_T 20
#define CTRL_S 19
#define CTRL_Q 17

typedef struct{
    int ls;
    int s;
    unsigned long pid;
    short chan;
} arg_t;

typedef struct{
    short status;
    short count;
    int pid;
} iosb_t;

typedef struct {
        int *flink;
        int (*exit_handler)();
        unsigned int arg;
        int *status;
        char *filbuf;
        short *termchan;
}desblk_t;

typedef struct {
    unsigned char class;
    unsigned char type;
    unsigned short width;
    unsigned int termchar:24;
    unsigned char length;
} termchar_t;

jmp_buf main_env;
jmp_buf keyboard_input_thr_env;
jmp_buf socket_input_thr_env;
pthread_t keyboard_input_thr;
pthread_t socket_input_thr;

short set_terminal_noecho(short TTchan, int set){
  int status;
  iosb_t iosb;
  typedef struct{
     unsigned char   clas;
     unsigned char   type;
     short   int     buffer_size;
     unsigned int    basic_chars;
     unsigned int    extended_chars;
  } Dev_char_t;
  Dev_char_t modified_chars;

  status = sys$qiow (0, TTchan, IO$_SENSEMODE, &iosb, 0, 0,
                     &modified_chars, sizeof(modified_chars), 0, 0, 0, 0);
  if (status & 1) status = iosb.status;
  if (!status & 1){
      sys$dassgn(TTchan);
      return 0;
  }
  if (set){
      modified_chars.basic_chars |= TT$M_NOECHO;
  } else {
      modified_chars.basic_chars &= ~TT$M_NOECHO;
  }
  status = sys$qiow (0, TTchan, IO$_SETMODE, &iosb, 0, 0,
                     &modified_chars, sizeof(modified_chars), 0, 0, 0, 0);
  if (status & 1) status = iosb.status;
  if (!status & 1){
      sys$dassgn(TTchan);
      return 0;
  }
  return TTchan;
}

short get_terminal_chan(char *term){
  struct dsc$descriptor_s TTdescr = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
  short TTchan;
  int status;

  TTdescr.dsc$w_length = strlen(term);
  TTdescr.dsc$a_pointer = term;
  if (!((status = sys$assign (&TTdescr,&TTchan,0,0)) & 1))
     return 0;
  return TTchan;
}
int get_terminal_input(short TTchan, char *buf, int size){
   int status,i;
   struct item_list_type {
        unsigned short Buffer_length;
        unsigned short Item_code;
        int Buffer_addr;
        int Return_addr ;
   };
   char mask[256/8];
   struct item_list_type Item_list[3];
   char *escape;
   unsigned int escape_num;
   /*
   ** Describe the iosb.
   */
   struct { short status;short offset;char terminator;
          char res1;char term_length; unsigned char Cursor_pos_from_EOL;} 
          iosb;

   for (i = 0; i < sizeof mask; i++) mask[i] = -1;
   mask[CTRL_C/8] &= ~(1 << (CTRL_C%8));
   mask[CTRL_Y/8] &= ~(1 << (CTRL_Y%8));
   mask[CTRL_O/8] &= ~(1 << (CTRL_O%8));
   mask[CTRL_X/8] &= ~(1 << (CTRL_X%8));
   mask[CTRL_T/8] &= ~(1 << (CTRL_T%8));
   mask[CTRL_S/8] &= ~(1 << (CTRL_S%8));
   mask[CTRL_Q/8] &= ~(1 << (CTRL_Q%8));

   /*
   ** Build the Item list in order to be returned in the buffer (TTbuf), the
   ** terminator character (like carriage return) or string (escape sequence)
   */
   Item_list[0].Buffer_length = 0;
   Item_list[0].Item_code = TRM$_ESCTRMOVR;
   Item_list[0].Buffer_addr = 10;
   Item_list[0].Return_addr = 0;
   Item_list[1].Buffer_length = 0;
   Item_list[1].Item_code = TRM$_MODIFIERS;
   Item_list[1].Buffer_addr = TRM$M_TM_NOFILTR | TRM$M_TM_ESCAPE
                                | TRM$M_TM_NORECALL;
   Item_list[1].Return_addr = 0;
   Item_list[2].Buffer_length = sizeof(mask);
   Item_list[2].Item_code = TRM$_TERM;
   Item_list[2].Buffer_addr = (int)&mask;
   Item_list[2].Return_addr = 0;
   TTchan = set_terminal_noecho(TTchan,1);
   /*
   ** Isssue the QIOW.
   */
   status = sys$qiow(0,TTchan,IO$_READVBLK|IO$M_EXTEND,&iosb,0,0,buf,size,
                             0,0,&Item_list,sizeof (Item_list));
   TTchan = set_terminal_noecho(TTchan,0);

   if (status & 1) status = iosb.status;
   if (!(status & 1)){
      sys$dassgn(TTchan);
      return -1;
   }
   if (iosb.offset == 0) iosb.offset = iosb.term_length;
   return iosb.offset;
}
char *get_terminal_device_type(char *term){
     short chan;
     struct dsc$descriptor_s ttdescr = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
     int status;
     iosb_t iosb;
     termchar_t termchar;
     char *device_type;

     ttdescr.dsc$w_length = strlen(term);
     ttdescr.dsc$a_pointer = term;
     status = sys$assign(&ttdescr,&chan,0,0);
     if (!(status & 1)) return NULL;
     status = sys$qiow(0,chan,IO$_SENSEMODE,&iosb,0,0,
                       &termchar,sizeof(termchar),0,0,0,0);
     if (status & 1) status = iosb.status;
     if (!(status & 1)){
         sys$dassgn(chan);
         return NULL;
     }

     switch(termchar.type){
        case TT$_VT52 :
             device_type = "VT52";
             break;
        case TT$_VT55 :
             device_type = "VT55";
             break;
        case TT$_VT100 :
             device_type = "VT100";
             break;
        case TT$_VT101 :
             device_type = "VT101";
             break;
        case TT$_VT102 :
             device_type = "VT102";
             break;
        case TT$_VT105 :
             device_type = "VT105";
             break;
        case TT$_VT125 :
             device_type = "VT125";
             break;
        case TT$_VT131 :
             device_type = "VT131";
             break;
        case TT$_VT132 :
             device_type = "VT132";
             break;
        case TT$_VT80 :
             device_type = "VT173";
             break;
        case TT$_VT200_SERIES :
             device_type = "VT200";
             break;
        case TT$_PRO_SERIES :
             device_type = "PRO_SERIES";
             break;
        case TT$_VT300_SERIES :
             device_type = "VT300";
             break;
        case TT$_VT400_SERIES :
             device_type = "VT400";
             break;
        case TT$_VT500_SERIES :
             device_type = "VT500";
             break;
        default :
             device_type = "UNKNOWN";
     }
     sys$dassgn(chan);
     return device_type;
}

void sighandler(int sig){
    if (sig == SIGINT || sig == SIGTERM){
        if (pthread_self() == keyboard_input_thr){
            longjmp(keyboard_input_thr_env,1);
        }
        else if (pthread_self() == socket_input_thr){
            longjmp(socket_input_thr_env,1);
        }
        else{
            longjmp(main_env,1);
        }
    }
}

void declsighandler(){
    struct sigaction action;

    sigemptyset(&action.sa_mask);
    sigaddset(&action.sa_mask,SIGTERM);
    action.sa_flags = 0;
    action.sa_handler = sighandler;
    sigaction(SIGINT,&action,NULL);
    sigemptyset(&action.sa_mask);
    sigaddset(&action.sa_mask,SIGINT);
    sigaction(SIGTERM,&action,NULL); 

}

int write_to_socket(int s, char *buf, int buflen) {
    char *cp = buf;
    int len;

    while (( len = send(s, cp, buflen,0) ) < buflen && len != -1){
        buflen -= len;                                 
        cp += len;                              
    }                                           
    return ((int)((cp+len)-buf));
}

void *keyboard_input(void *ptr){
    arg_t *arg= (arg_t *)ptr;
    int i;
    char *buf;
    fd_set wr;
    char ctrl_z = CTRL_Z;
    int j;

    arg->chan = 0;
    if (isatty(0))
        arg->chan=get_terminal_chan(ttyname(0));

    buf=malloc(MAXMSG);

    declsighandler();
    if (setjmp(keyboard_input_thr_env) == 1){
        free(buf);
        kill(arg->pid,SIGINT);
        return NULL;
    }
    while(1){
        memset(buf,0,MAXMSG);
        if (!arg->chan){
            for (i= 0; i < MAXMSG; i++) {
               buf[i]= getchar();
               if (buf[i]==-1 || buf[i]=='\n')
                  break;
            }
        }
        else{
           if ((i = get_terminal_input(arg->chan, buf, MAXMSG)) == -1){
               free(buf);
               return NULL;
           }
        }
        if (i==MAXMSG-1)
            exit (CLI$_BUFOVF);
        if (buf[i] == -1){
            send(arg->s,&ctrl_z,1,0);
            free(buf);
            return NULL;
        }
        if (!arg->chan){
            buf[i++] = '\r';
        }
        if (write_to_socket(arg->s,buf,i) != i){
            free(buf);
            close(arg->s);
            return NULL;
        }
    }
}

void *socket_input(void *ptr){
    arg_t *arg = (arg_t *)ptr;
    char *buf;
    char *cp;
    size_t len;
    int s,status, buflen;
    struct sockaddr_in from;
    fd_set rmask;

    len = sizeof(from);
    if ((arg->s = accept(arg->ls,(struct sockaddr *)&from, &len)) < 0){
        perror ("accept");
        exit(EXIT_FAILURE);
    }
    /*
     * Start one thread reading on stdin and writing on s.
     */
    if ((status = pthread_create(&keyboard_input_thr,NULL,
                                 keyboard_input,arg)) != 0){
        fprintf(stderr,"Error creating thread : %s\n",strerror(status));
        exit(EXIT_FAILURE);
    }
    buf = malloc(MAXMSG);
    declsighandler();
    if (setjmp(socket_input_thr_env) == 1){
        kill(arg->pid,SIGINT);
    }
    FD_ZERO(&rmask);
    FD_SET(arg->s,&rmask);
    while (select(arg->s+1,&rmask, NULL,NULL, NULL) != -1){
        if (FD_ISSET(arg->s,&rmask)){
            if ((buflen = recv(arg->s, buf ,MAXMSG , 0)) > 0){
                 if (buflen > 2 && !strncmp(buf,"\r\n",2))
                     printf("%.*s", buflen-2, buf+2);
                 else
                     printf("%.*s", buflen, buf);
                 fflush(stdout);
            }
            else {
                 break;
            }
        FD_ZERO(&rmask);
        FD_SET(arg->s,&rmask);
        }
    }
    free(buf);
    close(arg->s);
    close(arg->ls);
    return NULL;
} 

int spawn(char *str, int *child_status, char *tna_name, 
          unsigned int *efn, unsigned long *pid){
    int status;
    int flags = CLI$M_NOWAIT|CLI$M_NOCONTROL;
    struct dsc$descriptor_s input = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
    struct dsc$descriptor_s output;
    struct dsc$descriptor_s command = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};

    if (!str)
        return SS$_ABORT;
    input.dsc$w_length  = strlen(tna_name);
    input.dsc$a_pointer = tna_name;
    memcpy(&output, &input, sizeof(output));
    command.dsc$w_length = strlen(str);
    command.dsc$a_pointer = str;
    lib$get_ef(efn);
    status = lib$spawn(&command,&input,&output,&flags,NULL,
                              pid,child_status,efn);
    return status;
}

int set_terminal(int fd, short *tnachan,  char **tna_name){
    short chan;
    int status;
    int retlen;
    struct sockaddr_in to;
    unsigned int tolen;
    int devchar;
    int devchar2;
    unsigned short len;
    int tna_unit_number = 0;
    int devsts;            
    /* Item list sys$getdvi */
    typedef struct {  /* Standard OpenVMS item definition */
        unsigned short length; 
        unsigned short code;   
        void *buffer;          
        void *retlen;          
    } item_t;
    iosb_t iosb;
    struct dsc$descriptor_s input = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
    item_t *getdvi_itmlst;

    tolen=sizeof(to);
    if (getpeername(fd,(struct sockaddr *)&to,&tolen)<0)
        return SS$_ABORT;

    getdvi_itmlst = calloc(4,sizeof(item_t));
    getdvi_itmlst[0].length = sizeof(devchar);
    getdvi_itmlst[0].code = DVI$_DEVCHAR;
    getdvi_itmlst[0].buffer = &devchar;
    getdvi_itmlst[0].retlen = &len;
    getdvi_itmlst[1].length = sizeof(devchar2);
    getdvi_itmlst[1].code = DVI$_DEVCHAR2;
    getdvi_itmlst[1].buffer = &devchar2;
    getdvi_itmlst[1].retlen = &len;
    getdvi_itmlst[2].length = sizeof(devsts);
    getdvi_itmlst[2].code = DVI$_STS;
    getdvi_itmlst[2].buffer = &devsts;
    getdvi_itmlst[2].retlen = &len;
    do {
        sprintf(*tna_name,"%s%1d:",TNA_DEVICE,++tna_unit_number);
        input.dsc$w_length=strlen(*tna_name);
        input.dsc$a_pointer = *tna_name;
        status = sys$getdviw (EFN$C_ENF,
                        0,
                        &input,
                        getdvi_itmlst,
                        &iosb,
                        0,
                        0,
                        0 );
        if (status & 1) status = iosb.status;

        if (status == SS$_NORMAL || status == SS$_DEVOFFLINE)
            continue;
        if (status != SS$_NOSUCHDEV)
            status = SS$_ABORT;
        if ((status == SS$_NOSUCHDEV) || (status == SS$_ABORT))
            break;
    } while (1);
    free (getdvi_itmlst);
    if (status == SS$_NOSUCHDEV){
        chan = vaxc$get_sdc(fd);
        status = create_terminal(*tna_name,chan,tnachan);
    }
    return status;
}
int cleanup (int *stat,char *filbuf, short *termchan)
{
    struct stat st;

    if (strlen(filbuf) && lstat(filbuf,&st) == 0)
        remove(filbuf);
    if (*termchan){
        sys$cancel(*termchan);
        set_terminal_noecho(*termchan,0);
        sys$dassgn(*termchan);
    }
    return *stat;
}
int main(int argc, char **argv){
    int ls, s,fd;
    static char filbuf[PATH_MAX] = "";
    int i, n, m;
    unsigned int len;
    static int status;
    iosb_t iosb;
    short tnachan = -1;
    int child_status;
    unsigned int efn;
    pthread_attr_t attr;
    struct sched_param param = {PRI_FIFO_MAX};
    arg_t arg;
    char tna_name[DEVICE_NAME_LENGTH];
    char *tna_dev_name = tna_name;
    struct sockaddr_in to;
    char dcl_command[MAXMSG];
    char tmpbuf[MAXMSG];
    desblk_t desblk;

    if (argc == 1){
        fprintf (stderr,"%%DCL.EXE-F-DCL.EXE requires a DCL command\n");
        exit(EXIT_FAILURE);
    }

    /*
     * Initialize the declare exit handler data block and call $DCLEXH
     */
    desblk.exit_handler = &cleanup;
    desblk.arg = 3;
    desblk.status = &status;
    desblk.filbuf = filbuf;
    desblk.termchan = &arg.chan;
    status = sys$dclexh(&desblk);
    if (!(status & 1)) {
        printf("Failed to declare exit handler.\n");
        exit(status);
    }

    argc--;
    argv++;
    memset(dcl_command,0,sizeof(dcl_command));
    n = 0;
    for (i=0; i < argc; i++){
         m = strlen(argv[i]);
         if (n)
             dcl_command[n++] = ' ';
         strncpy(&dcl_command[n],argv[i],m);
         n += m;
    }
    /*
     * Create an anonymous socket.
     */
    if ((ls = socket(AF_INET,SOCK_STREAM,0)) < 0){
        perror("socket");
        status = EXIT_FAILURE;
        exit(status);
    }
    to.sin_family = AF_INET;
    to.sin_port = 0;
    to.sin_addr.s_addr = htonl(INADDR_ANY);

    if (bind(ls,(struct sockaddr *)&to, sizeof(to)) != 0){
        perror("bind");
        status = EXIT_FAILURE;
        exit(status);
    }  
    len = sizeof(to);

    if (getsockname(ls, (struct sockaddr *)&to, &len) < 0) {
        perror("getsockname");
        status = EXIT_FAILURE;
        exit(status);
    }

    if (listen(ls,1) < 0){
        perror("listen");
        status = EXIT_FAILURE;
        exit(status);
    }

    /*
     * Start one thread accepting connections on ls.
     */
    arg.ls = ls;
    if ((status = pthread_attr_init(&attr)) != 0){
        fprintf(stderr,"Error creating thread : %s\n",strerror(status));
        status = EXIT_FAILURE;
        exit(status);
    }                   

    if ((status = pthread_attr_setinheritsched(&attr,PTHREAD_EXPLICIT_SCHED)) != 0){
        fprintf(stderr,"Error creating thread : %s\n",strerror(status));
        status = EXIT_FAILURE;
        exit(status);
    }                   

    if ((status = pthread_attr_setschedpolicy(&attr,SCHED_FIFO)) != 0){
        fprintf(stderr,"Error creating thread : %s\n",strerror(status));
        status = EXIT_FAILURE;
        exit(status);
    }                   

    if ((status = pthread_attr_setschedparam(&attr,&param)) != 0){
        fprintf(stderr,"Error creating thread : %s\n",strerror(status));
        status = EXIT_FAILURE;
        exit(status);
    }                   

    if ((status = pthread_create(&socket_input_thr,&attr,socket_input,&arg)) != 0){
        fprintf(stderr,"Error creating thread : %s\n",strerror(status));
        status = EXIT_FAILURE;
        exit(status);
    }

    if ((s = socket(AF_INET,SOCK_STREAM,0)) < 0){
        perror("socket");
        status = EXIT_FAILURE;
        exit(status);
    }

    if (connect(s, (struct sockaddr *)&to, len) < 0) {
        perror("connect");
        status = EXIT_FAILURE;
        exit(status);
    }

    status = set_terminal(s,&tnachan,&tna_dev_name);
    if (!(status & 1)) return status;
    strcpy(filbuf,"tempXXXXXX");
    if ((fd = mkstemp(filbuf)) == -1){
        perror("mkstemp");
        status = EXIT_FAILURE;
        exit(status);
    }

    strcpy(tmpbuf,"$ on error then logout\n");
    if (write(fd,tmpbuf,strlen(tmpbuf)) != strlen(tmpbuf)){
        perror("write");
        close(fd);
        status = EXIT_FAILURE;
        exit(status);
    }

    if (isatty(0)){
        sprintf(tmpbuf,"$ set terminal/device=%s\n",
                 get_terminal_device_type(ttyname(0)));
        if (write(fd,tmpbuf,strlen(tmpbuf)) != strlen(tmpbuf)){
            perror("write");
            close(fd);
            status = EXIT_FAILURE;
            exit(status);
        }
    }
    else {
        strcpy(tmpbuf,"$ set terminal/noecho\n");
        if (write(fd,tmpbuf,strlen(tmpbuf)) != strlen(tmpbuf)){
            perror("write");
            close(fd);
            status = EXIT_FAILURE;
            exit(status);
        }
    }

    sprintf(tmpbuf,"$ define/user sys$input %s\n",tna_dev_name);
    if (write(fd,tmpbuf,strlen(tmpbuf)) != strlen(tmpbuf)){
        perror("write");
        close(fd);
        status = EXIT_FAILURE;
        exit(status);
    }      
           
    sprintf(tmpbuf,"$ %s\n",dcl_command);
    if (write(fd,tmpbuf,strlen(tmpbuf)) != strlen(tmpbuf)){
        perror("write");
        close(fd);
        status = EXIT_FAILURE;
        exit(status);
    }
    strcpy(tmpbuf,"$ logout\n");
    if (write(fd,tmpbuf,strlen(tmpbuf)) != strlen(tmpbuf)){
        perror("write");
        close(fd);
        status = EXIT_FAILURE;
        exit(status);
    }
    close(fd);
    sprintf (tmpbuf,"@%s.;",filbuf);

    /*
     * Intercept SIGINT and SIGTERM signals.
     */
    declsighandler();
    if (setjmp (main_env) == 1){
        kill(arg.pid,SIGINT);
    }
    else{
        status = spawn(tmpbuf, &child_status, tna_name, &efn, &arg.pid);
    }
    if (status & 1) status = sys$waitfr(efn);
    if (status & 1){
        if (tnachan != -1) status = sys$dassgn(tnachan);
        if (status & 1){
           status = delete_tna_device(tna_name);
        }
        lib$free_ef(&efn);
        close(s);
        pthread_join(socket_input_thr,NULL);
    }

    if (status & 1){
        if ((child_status & 1) && child_status != SS$_NORMAL)
            child_status = SS$_NORMAL;
        status = child_status;
    }
    exit(status);
    return 1;
}

************
* tn.h
************
/*
 *       Copyright (C) 2011 by Philippe.Vouters@laposte.net
 *
 *   This program is free software: you can redistribute it and/or modify
 *   it under the terms of the GNU General Public License as published by the
 *   Free Software Foundation, either version 3 of the License, or
 *   any later version.
 *
 *   This program is distributed in the hope that it will be useful,
 *   but WITHOUT ANY WARRANTY; without even the implied warranty of
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *   GNU General Public License for more details.
 *
 *   You should have received a copy of the GNU General Public License
 *   along with this program.  If not, see <http://www.gnu.org/licenses/>;.
 */
#ifndef __TN_H
#define __TN_H
extern int create_terminal(char *,short, short *);
extern int create_tna_device(char *,short);
extern int delete_tna_device(char *);
#endif

************
* tn.c
************
/*
 *       Copyright (C) 2011 by Philippe.Vouters@laposte.net
 *
 *   This program is free software: you can redistribute it and/or modify
 *   it under the terms of the GNU General Public License as published by the
 *   Free Software Foundation, either version 3 of the License, or
 *   any later version.
 *
 *   This program is distributed in the hope that it will be useful,
 *   but WITHOUT ANY WARRANTY; without even the implied warranty of
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *   GNU General Public License for more details.
 *
 *   You should have received a copy of the GNU General Public License
 *   along with this program.  If not, see <http://www.gnu.org/licenses/>;.
 */
#ifndef _SOCKADDR_LEN
#define _SOCKADDR_LEN   /* this is required for the BSD 4.4  struct sockaddr */
#endif
#include <types.h>
#include <socket.h>
#include <in.h>
#include <inet.h>
#include <netdb.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <tniodef.h>
#include <ttdef.h>
#include <tt2def.h>
#include <tcpip$inetdef.h>
#include <descrip.h>
#include <starlet.h>
#include <iodef.h>
#include <ssdef.h>
#include <dcdef.h>
#include <ttdef.h>
#include <dvidef.h>
#include <devdef.h>
#include <ucbdef.h>

typedef struct {  /* I/O Status Block */
    unsigned short status;
    unsigned short count;
    unsigned long funcdep;
} iosb_t;

typedef struct {  /* Structure descriptor */
    unsigned long length;
    void *address;
} struct_desc_t;

typedef struct {  /* Item definition for TELNET QIO services */
    unsigned short length;
    unsigned short code;
    void *buffer;
} item_l2_t;

typedef struct {  /* Standard OpenVMS item definition */
    unsigned short length;
    unsigned short code;
    void *buffer;
    void *retlen;
} item_t;

typedef struct {
    unsigned char class;
    unsigned char type;
    unsigned short width;
    unsigned int termchar:24;
    unsigned char length;
} termchar_t;

/*
 * The delete_tna_device acts very much like the TELNET> DELETE_SESSION in
 * all its visible aspects on the target TNA and associated BG device.
 */
int delete_tna_device(char *tnname){
    struct dsc$descriptor_s tn_dev = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
    struct dsc$descriptor_s bg_dev = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
    int status;
    item_l2_t *itmlst;
    item_t *getdvi_itmlst;
    iosb_t iosb;
    int devchar;
    int devchar2;
    int devsts;
    unsigned short tnchan,BGchan;
    unsigned short len;
    char BGname[64];

    tn_dev.dsc$w_length = strlen(tnname);
    tn_dev.dsc$a_pointer=tnname;
    getdvi_itmlst = calloc(4,sizeof(item_t));
    getdvi_itmlst[0].length = sizeof(devchar);
    getdvi_itmlst[0].code = DVI$_DEVCHAR;
    getdvi_itmlst[0].buffer = &devchar;
    getdvi_itmlst[0].retlen = &len;
    getdvi_itmlst[1].length = sizeof(devchar2);
    getdvi_itmlst[1].code = DVI$_DEVCHAR2;
    getdvi_itmlst[1].buffer = &devchar2;
    getdvi_itmlst[1].retlen = &len;
    getdvi_itmlst[2].length = sizeof(devsts);
    getdvi_itmlst[2].code = DVI$_STS;
    getdvi_itmlst[2].buffer = &devsts;
    getdvi_itmlst[2].retlen = &len;
    status = sys$getdviw( 0, 0, &tn_dev, getdvi_itmlst, &iosb, NULL, 0, NULL);
    free (getdvi_itmlst);
    if (status & 1) status = iosb.status;
    if (!(status & 1)) {
        if ((status != SS$_NOSUCHDEV) && (status != SS$_DEVOFFLINE))
             printf("Failed to get %s device dependent characteristics.\n",
                     tnname);
        return(status);
    }
    /*
     * Check inbound Telnet devices and templates or temporary UCBs.
     * Do not delete them.
     */
    if ((!(devchar & DEV$M_AVL))  || (devchar2 & DEV$M_RED) ||
        ((devsts & UCB$M_TEMPLATE) & (!(devsts & UCB$M_DELETEUCB))))
          return (SS$_NORMAL);

    status = sys$assign(&tn_dev, &tnchan, 0, 0);
    if (!(status & 1)) {
        printf("Failed to assign channel to %s channel.\n",tnname);
        return(status);
    }

    /*
     * Allocate and Build the item list.
     */
    itmlst = calloc(2,sizeof(item_l2_t));
    itmlst[0].length = sizeof(BGname);
    itmlst[0].code = TN$_NETWORK_DEVICE_NAME;
    itmlst[0].buffer = BGname;

    status = sys$qiow(0, tnchan, IO$_TTY_PORT_BUFIO | IO$M_TN_SENSEMODE,
                      &iosb, 0, 0, 0, 0, 0, 0, itmlst , 0); 
    free(itmlst);
    if (status & 1) status = iosb.status;
    if (!(status & 1)) {
        printf("Failed to SENSEMODE %s device.Status=%1x\n",tnname,status);
        return(status);
    }
    bg_dev.dsc$w_length = BGname[0];
    bg_dev.dsc$a_pointer=&BGname[1];
    status = sys$assign(&bg_dev, &BGchan, 0, 0);
    if (!(status & 1)) {
        printf("Failed to assign channel to %.*s.\n",BGname[0],&BGname[1]);
        return(status);
    }
    status = sys$qiow(0, tnchan, IO$_TTY_PORT |  IO$M_TN_SHUTDOWN,
                      &iosb, 0, 0, BGchan, 0, 0, 0, 0 , 0); 
    if (status & 1) status = iosb.status;
    if (!(status & 1)) {
        printf("Failed to SHUTDOWN %s device.Status=%1x\n",tnname,status);
        return(status);
    }
    status = sys$dassgn(BGchan);
    if (!(status & 1)){
        printf("Failed to deassign the %.*s channel.\n",BGname[0],&BGname[1]);
        return(status);
    }
    /*
     * Deassign temporary channel.
     */

    status = sys$dassgn(tnchan);
    if (!(status & 1)){
        printf("Failed to deassign the %s channel.\n",tnname);
        return(status);
    }
    return (status);

}
/*
 * The create_tna_device acts very much like the TELNET> CREATE_SESSION in
 * all its visible aspects on the created TNA and associated BG device.
 */
int create_tna_device(char *tn_device,short BGchan){
    $DESCRIPTOR(tna0_dev,"TNA0:");
    $DESCRIPTOR(inet_dev,"UCX$DEVICE");
    struct dsc$descriptor_s dev = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
    unsigned short tna0chan;
    struct {
        unsigned char len;
        char devname[63];
    } ASCIC_devname;
    int protocol = TN$K_PROTOCOL_RAW;
    int service_type = TN$K_SERVICE_NONE;
    int status;
    int devchar;
    item_l2_t *itmlst;
    item_t *getdvi_itmlst;
    iosb_t iosb;
    int characteristics = /*TN$M_PERMANENT_UCB | TN$M_RETAIN_ON_DASSGN | */
                          TN$M_AUTOCONNECT ;
    int device_unit;
    char junk[50];
    unsigned short len;

    /*
     * Check this is the TNA device.
     */
    if (strncasecmp(tn_device,"TNA",3) != 0) return (SS$_ABORT);
    /* Get device unit. */
    status = sscanf(tn_device,"%c %c %c %d %c",&junk[0],&junk[1],&junk[2],
                                &device_unit,&junk[3]);
    if (status != 5) return (SS$_ABORT);

    dev.dsc$w_length = strlen(tn_device);
    dev.dsc$a_pointer = tn_device;

    getdvi_itmlst = calloc(2,sizeof(item_t));
    getdvi_itmlst[0].length = sizeof(devchar);
    getdvi_itmlst[0].code = DVI$_DEVCHAR;
    getdvi_itmlst[0].buffer = &devchar;
    getdvi_itmlst[0].retlen = &len;
    status = sys$getdviw( 0, 0, &dev, getdvi_itmlst, &iosb, NULL, 0, NULL);
    free (getdvi_itmlst);
    if (status & 1) status = iosb.status;
    if ((status & 1)) {
         if (!(devchar & DEV$M_AVL))
              return (SS$_DEVOFFLINE);

        printf("Device %s device already exists.Not created\n",tn_device);
        return(SS$_DEVALRALLOC);
    }
    status = sys$assign(&tna0_dev, &tna0chan, 0, 0);
    if (!(status & 1)) {
        printf("Failed to assign channel to TNA0.\n");
        return(status);
    }
    /*
     * Allocate and Build the item list.
     * When the sys$qiow completes, we get
     * an unconnected TNA device.
     */
    itmlst = calloc(6,sizeof(item_l2_t));
    itmlst[0].length = sizeof (int);
    itmlst[0].code = TN$_SERVICE_TYPE;
    itmlst[0].buffer = &service_type;
    itmlst[1].length = sizeof (int);
    itmlst[1].code = TN$_PROTOCOL;
    itmlst[1].buffer = &protocol;
    itmlst[2].length = sizeof (int);
    itmlst[2].code = TN$_DEVICE_UNIT;
    itmlst[2].buffer = &device_unit;
    itmlst[3].length = sizeof (int);
    itmlst[3].code = TN$_CHARACTERISTICS;
    itmlst[3].buffer = &characteristics;
    status = sys$qiow(0, tna0chan, IO$_TTY_PORT_BUFIO | IO$M_TN_SETMODE, &iosb,
                        0, 0, 0, 0,
                        0, 0, itmlst , 0); 
    free(itmlst);
    if (status & 1) status = iosb.status;
    if (!(status & 1)) {
        printf("Failed to create %s terminal.\n",tn_device);
        return(status);
    }

    /*
     * Binds our socket to the TELNET terminal.
     */
    status = sys$qiow(0, tna0chan, IO$_TTY_PORT | IO$M_TN_STARTUP,
                        &iosb, 0, 0, BGchan, protocol, characteristics,
                        0, 0, 0);
    if (status & 1) status = iosb.status;
    if (!(status & 1)) {
        printf("Failed to bind to a TELNET terminal.\n");
        return(status);
    }
    /*
     * Deassign TNAxxxx temporary channel.
     */
    status = sys$dassgn(tna0chan);
    if (!(status & 1)){
        printf("Failed to deassign the TNA0 channel.\n");
        return(status);
    }
    return (status);
}

int create_terminal(char *tn_device, short BGchan,short *tnachan){
    $DESCRIPTOR (inet_dev,"UCX$DEVICE");
    unsigned short tnchan,socket_channel;
    int status;
    iosb_t iosb_r,iosb_w;
    short sck_parm[2];  /* Socket creation parameter */

    termchar_t termchar;
    char buffer[100],*buf;
    struct dsc$descriptor_s tn_dev = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};

    status = create_tna_device(tn_device,BGchan);
    if (!(status & 1)){
        printf ("Failed to create %s device.\n",tn_device);
        return(status);
    }
    else{
        /*
         * Set TNAxxx: string descriptor.
         */
        tn_dev.dsc$w_length = strlen(tn_device);
        tn_dev.dsc$a_pointer = tn_device;
        /*
         * Assign and return channel to dynamically created device.
         */
        if (!((status = sys$assign(&tn_dev, &tnchan, 0, 0)) & 1)) {
             printf ("Failed to assign channel from %s device.\n",tn_device);
             return(status);
        }
    }

    /*
     * Get the current terminal characteristics for this TNAxxx device.
     */
    status = sys$qiow (0, tnchan, IO$_SENSEMODE, &iosb_r, 0, 0,
                        &termchar, sizeof (termchar), 0, 0, 0, 0);
    if (status & 1) status = iosb_r.status;
    if (!(status & 1)) {
        printf("Failed to get %s terminal characteristics.\n",tn_device);
        return(status);
    }
    /*
     * Set the terminal type for this TNAxxx device.
     */
    if (termchar.class != DC$_TERM) return (SS$_ABORT);
    *tnachan = tnchan;
    return(SS$_NORMAL);
}


RELATED ARTICLE:

../tima/OpenVMS-Java-Executing_DCL_commands.html


REFERENCE(S):

A Perl solution also using a Telnet terminal device is also avaible at:
../tima/All-OS-FTP-Perl-Remotely_executing_a_script.html