apps/plugins/pdbox/PDa/src/t_tkcmd.c

   1 /* Copyright (c) 1997-1999 Miller Puckette.
   2 * For information on usage and redistribution, and for a DISCLAIMER OF ALL
   3 * WARRANTIES, see the file, "LICENSE.txt," in this distribution.  */
   4
   5 #ifdef UNIX     /* in unix this only works first; in NT it only works last. */
   6 #include "tk.h"
   7 #endif
   8
   9 #include "t_tk.h"
  10 #include <stdlib.h>
  11 #include <string.h>
  12 #include <stdio.h>
  13 #include <stdarg.h>
  14 #include <sys/types.h>
  15 #ifdef UNIX
  16 #include <unistd.h>
  17 #include <sys/socket.h>
  18 #include <netinet/in.h>
  19 #include <netdb.h>
  20 #ifdef HAVE_BSTRING_H
  21 #include <bstring.h>
  22 #endif
  23 #include <sys/time.h>
  24 #include <errno.h>
  25 #endif
  26 #ifdef MSW
  27 #include <winsock.h>
  28 #include <io.h>
  29 #endif
  30 #ifdef MSW
  31 #pragma warning( disable : 4305 )  /* uncast const double to float */
  32 #pragma warning( disable : 4244 )  /* uncast double to float */
  33 #pragma warning( disable : 4101 )  /* unused local variables */
  34 #endif
  35
  36 #ifdef MSW
  37 #include "tk.h"
  38 #endif
  39
  40 void tcl_mess(char *s);
  41
  42 /***************** the socket setup code ********************/
  43
  44 static int portno = 5400;
  45
  46         /* some installations of linux don't know about "localhost" so give
  47         the loopback address; NT, on the other hand, can't understand the
  48         hostname "127.0.0.1". */
  49 char hostname[100] =
  50 #ifdef __linux__
  51     "127.0.0.1";
  52 #else
  53     "localhost";
  54 #endif
  55
  56 void pdgui_setsock(int port)
  57 {
  58     portno = port;
  59 }
  60
  61 void pdgui_sethost(char *name)
  62 {
  63     strncpy(hostname, name, 100);
  64     hostname[99] = 0;
  65 }
  66
  67 static void pdgui_sockerror(char *s)
  68 {
  69 #ifdef MSW
  70     int err = WSAGetLastError();
  71 #endif
  72 #ifdef UNIX
  73     int err = errno;
  74 #endif
  75
  76     fprintf(stderr, "%s: %s (%d)\n", s, strerror(err), err);
  77     tcl_mess("exit\n");
  78     exit(1);
  79 }
  80
  81 static int sockfd;
  82
  83 /* The "pd_suck" command, which polls the socket.
  84     FIXME: if Pd sends something bigger than SOCKSIZE we're in trouble!
  85     This has to be set bigger than any array update message for instance.
  86 */
  87 #define SOCKSIZE 20000
  88
  89 static char pd_tkbuf[SOCKSIZE+1];
  90 int pd_spillbytes = 0;
  91
  92 static void pd_readsocket(ClientData cd, int mask)
  93 {
  94     int ngot;
  95     fd_set readset, writeset, exceptset;
  96     struct timeval timout;
  97
  98     timout.tv_sec = 0;
  99     timout.tv_usec = 0;
 100     FD_ZERO(&writeset);
 101     FD_ZERO(&readset);
 102     FD_ZERO(&exceptset);
 103     FD_SET(sockfd, &readset);
 104     FD_SET(sockfd, &exceptset);
 105
 106     if (select(sockfd+1, &readset, &writeset, &exceptset, &timout) < 0)
 107         perror("select");
 108     if (FD_ISSET(sockfd, &exceptset) || FD_ISSET(sockfd, &readset))
 109     {
 110         int ret;
 111         ret = recv(sockfd, pd_tkbuf + pd_spillbytes,
 112             SOCKSIZE - pd_spillbytes, 0);
 113         if (ret < 0) pdgui_sockerror("socket receive error");
 114         else if (ret == 0)
 115         {
 116             /* fprintf(stderr, "read %d\n", SOCKSIZE - pd_spillbytes); */
 117             fprintf(stderr, "pd_gui: pd process exited\n");
 118             tcl_mess("exit\n");
 119         }
 120         else
 121         {
 122             char *lastcr = 0, *bp = pd_tkbuf, *ep = bp + (pd_spillbytes + ret);
 123             int brace = 0;
 124             char lastc = 0;
 125             while (bp < ep)
 126             {
 127                 char c = *bp;
 128                 if (c == '}' && brace) brace--;
 129                 else if (c == '{') brace++;
 130                 else if (!brace && c == '\n' && lastc != '\\') lastcr = bp;
 131                 lastc = c;
 132                 bp++;
 133             }
 134             if (lastcr)
 135             {
 136                 int xtra = pd_tkbuf + pd_spillbytes + ret - (lastcr+1);
 137                 char bashwas = lastcr[1];
 138                 lastcr[1] = 0;
 139                 tcl_mess(pd_tkbuf);
 140                 lastcr[1] = bashwas;
 141                 if (xtra)
 142                 {
 143                     /* fprintf(stderr, "x %d\n", xtra); */
 144                     memmove(pd_tkbuf, lastcr+1, xtra);
 145                 }
 146                 pd_spillbytes = xtra;
 147             }
 148             else
 149             {
 150                 pd_spillbytes += ret;
 151             }
 152         }
 153     }
 154 }
 155
 156 #ifndef UNIX
 157     /* if we aren't UNIX, we add a tcl command to poll the
 158     socket for data.  */
 159 static int pd_pollsocketCmd(ClientData cd, Tcl_Interp *interp,
 160     int argc, char **argv)
 161 {
 162     pd_readsocket(cd, 0);
 163     return (TCL_OK);
 164 }
 165 #endif
 166
 167 void pdgui_setupsocket(void)
 168 {
 169     struct sockaddr_in server;
 170     struct hostent *hp;
 171 #ifdef UNIX
 172     int retry = 10;
 173 #else
 174     int retry = 1;
 175 #endif
 176 #ifdef MSW
 177     short version = MAKEWORD(2, 0);
 178     WSADATA nobby;
 179
 180     if (WSAStartup(version, &nobby)) pdgui_sockerror("setup");
 181 #endif
 182
 183     /* create a socket */
 184     sockfd = socket(AF_INET, SOCK_STREAM, 0);
 185     if (sockfd < 0) pdgui_sockerror("socket");
 186
 187     /* connect socket using hostname provided in command line */
 188     server.sin_family = AF_INET;
 189
 190     hp = gethostbyname(hostname);
 191
 192     if (hp == 0)
 193     {
 194         fprintf(stderr,
 195             "localhost not found (inet protocol not installed?)\n");
 196         exit(1);
 197     }
 198     memcpy((char *)&server.sin_addr, (char *)hp->h_addr, hp->h_length);
 199
 200     /* assign client port number */
 201     server.sin_port = htons((unsigned short)portno);
 202
 203         /* try to connect */
 204     while (1)
 205     {
 206         if (connect(sockfd, (struct sockaddr *) &server, sizeof (server)) >= 0)
 207             goto gotit;
 208         retry--;
 209         if (retry <= 0)
 210             break;
 211           /* In UNIX there's a race condition; the child won't be
 212           able to connect before the parent (pd) has shed its
 213           setuid-ness.  In case this is the problem, sleep and
 214           retry. */
 215         else
 216         {
 217 #ifdef UNIX
 218             fd_set readset, writeset, exceptset;
 219             struct timeval timout;
 220
 221             timout.tv_sec = 0;
 222             timout.tv_usec = 100000;
 223             FD_ZERO(&writeset);
 224             FD_ZERO(&readset);
 225             FD_ZERO(&exceptset);
 226             fprintf(stderr, "retrying connect...\n");
 227             if (select(1, &readset, &writeset, &exceptset, &timout) < 0)
 228                 perror("select");
 229 #endif /* UNIX */
 230         }
 231     }
 232     pdgui_sockerror("connecting stream socket");
 233 gotit: ;
 234 #ifdef UNIX
 235         /* in unix we ask TK to call us back.  In NT we have to poll. */
 236     Tk_CreateFileHandler(sockfd, TK_READABLE | TK_EXCEPTION,
 237         pd_readsocket, 0);
 238 #endif /* UNIX */
 239 }
 240
 241 /**************************** commands ************************/
 242 static char *pdgui_path;
 243
 244 /* The "pd" command, which cats its args together and throws the result
 245 * at the Pd interpreter.
 246 */
 247 #define MAXWRITE 1024
 248
 249 static int pdCmd(ClientData cd, Tcl_Interp *interp, int argc,  char **argv)
 250 {
 251     if (argc == 2)
 252     {
 253         int n = strlen(argv[1]);
 254         if (send(sockfd, argv[1], n, 0) < n)
 255         {
 256             perror("stdout");
 257             tcl_mess("exit\n");
 258         }
 259     }
 260     else
 261     {
 262         int i;
 263         char buf[MAXWRITE];
 264         buf[0] = 0;
 265         for (i = 1; i < argc; i++)
 266         {
 267             if (strlen(argv[i]) + strlen(buf) + 2 > MAXWRITE)
 268             {
 269                 interp->result = "pd: arg list too long";
 270                 return (TCL_ERROR);
 271             }
 272             if (i > 1) strcat(buf, " ");
 273             strcat(buf, argv[i]);
 274         }
 275         if (send(sockfd, buf, strlen(buf), 0) < 0)
 276         {
 277             perror("stdout");
 278             tcl_mess("exit\n");
 279         }
 280     }
 281     return (TCL_OK);
 282 }
 283
 284 /***********  "c" level access to tk functions. ******************/
 285
 286 static Tcl_Interp *tk_myinterp;
 287
 288 void tcl_mess(char *s)
 289 {
 290     int result;
 291     result = Tcl_Eval(tk_myinterp,  s);
 292     if (result != TCL_OK)
 293     {
 294         if (*tk_myinterp->result) printf("%s\n",  tk_myinterp->result);
 295     }
 296 }
 297
 298 /* LATER should do a bounds check -- but how do you get printf to do that? */
 299 void tcl_vmess(char *fmt, ...)
 300 {
 301     int result, i;
 302     char buf[MAXWRITE];
 303     va_list ap;
 304
 305     va_start(ap, fmt);
 306
 307     vsprintf(buf, fmt, ap);
 308     result = Tcl_Eval(tk_myinterp, buf);
 309     if (result != TCL_OK)
 310     {
 311         if (*tk_myinterp->result) printf("%s\n",  tk_myinterp->result);
 312     }
 313     va_end(ap);
 314 }
 315
 316 #ifdef UNIX
 317 void pdgui_doevalfile(Tcl_Interp *interp, char *s)
 318 {
 319     char buf[GUISTRING];
 320     sprintf(buf, "set pd_guidir \"%s\"\n", pdgui_path);
 321     tcl_mess(buf);
 322     strcpy(buf, pdgui_path);
 323     strcat(buf, "/bin/");
 324     strcat(buf, s);
 325     if (Tcl_EvalFile(interp, buf) != TCL_OK)
 326     {
 327         char buf2[1000];
 328         sprintf(buf2, "puts [concat tcl: %s: can't open script]\n",
 329             buf);
 330         tcl_mess(buf2);
 331     }
 332 }
 333
 334 void pdgui_evalfile(char *s)
 335 {
 336     pdgui_doevalfile(tk_myinterp, s);
 337 }
 338 #endif
 339
 340 void pdgui_startup(Tcl_Interp *interp)
 341 {
 342
 343         /* save pointer to the main interpreter */
 344     tk_myinterp = interp;
 345
 346
 347         /* add our own TK commands */
 348     Tcl_CreateCommand(interp, "pd",  (Tcl_CmdProc*)pdCmd, (ClientData)NULL,
 349         (Tcl_CmdDeleteProc *)NULL);
 350 #ifndef UNIX
 351     Tcl_CreateCommand(interp, "pd_pollsocket",(Tcl_CmdProc*)  pd_pollsocketCmd,
 352         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
 353 #endif
 354     pdgui_setupsocket();
 355
 356         /* read in the startup file */
 357 #if !defined(MSW) && !defined(MACOSX)
 358     pdgui_evalfile("pd.tk");
 359 #endif
 360 }
 361
 362 #ifdef UNIX
 363 void pdgui_setname(char *s)
 364 {
 365     char *t;
 366     char *str;
 367     int n;
 368     if (t = strrchr(s, '/')) str = s, n = (t-s) + 1;
 369     else str = "./", n = 2;
 370     if (n > GUISTRING-100) n = GUISTRING-100;
 371     pdgui_path = malloc(n+9);
 372
 373     strncpy(pdgui_path, str, n);
 374     while (strlen(pdgui_path) > 0 && pdgui_path[strlen(pdgui_path)-1] == '/')
 375         pdgui_path[strlen(pdgui_path)-1] = 0;
 376     if (t = strrchr(pdgui_path, '/'))
 377         *t = 0;
 378 }
 379 #endif
 380
 381 int Pdtcl_Init(Tcl_Interp *interp)
 382 {
 383         const char *myvalue = Tcl_GetVar(interp, "argv", 0);
 384         int myportno;
 385         if (myvalue && (myportno = atoi(myvalue)) > 1)
 386                         pdgui_setsock(myportno);
 387         tk_myinterp = interp;
 388         pdgui_startup(interp);
 389         interp->result = "loaded pdtcl_init";
 390
 391         return (TCL_OK);
 392 }
 393
 394 int Pdtcl_SafeInit(Tcl_Interp *interp) {
 395     fprintf(stderr, "Pdtcl_Safeinit 51\n");
 396         return (TCL_OK);
 397 }
 398