1 /* This module implements an interface to posix system calls */
2 /* file stdio intrinsics for S-Lang */
3 /*
4 Copyright (C) 2004-2017,2018 John E. Davis
5 
6 This file is part of the S-Lang Library.
7 
8 The S-Lang Library is free software; you can redistribute it and/or
9 modify it under the terms of the GNU General Public License as
10 published by the Free Software Foundation; either version 2 of the
11 License, or (at your option) any later version.
12 
13 The S-Lang Library is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16 General Public License for more details.
17 
18 You should have received a copy of the GNU General Public License
19 along with this library; if not, write to the Free Software
20 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
21 USA.
22 */
23 
24 #include "slinclud.h"
25 
26 #if defined(__unix__) || (defined (__os2__) && defined (__EMX__))
27 # include <sys/types.h>
28 #endif
29 
30 #ifdef HAVE_FCNTL_H
31 # include <fcntl.h>
32 #else
33 # ifdef HAVE_SYS_FCNTL_H
34 #  include <sys/fcntl.h>
35 # endif
36 #endif
37 
38 #ifdef __unix__
39 # include <sys/file.h>
40 #endif
41 
42 #ifdef HAVE_IO_H
43 # include <io.h>
44 #endif
45 
46 #if defined(__BORLANDC__)
47 # include <dir.h>
48 #endif
49 
50 #if defined(__DECC) && defined(VMS)
51 # include <unixio.h>
52 # include <unixlib.h>
53 #endif
54 
55 #ifdef VMS
56 # include <stat.h>
57 #else
58 # include <sys/stat.h>
59 #endif
60 
61 #include <errno.h>
62 
63 #include "slang.h"
64 #include "_slang.h"
65 
66 #define SLSYSWRAP_OPEN open
67 #define SLSYSWRAP_READ read
68 #define SLSYSWRAP_WRITE write
69 #ifdef SLSYSWRAP
70 # include <slsyswrap.h>
71 #endif
72 
73 typedef struct _Stdio_MMT_List_Type
74 {
75    SLang_MMT_Type *stdio_mmt;
76    struct _Stdio_MMT_List_Type *next;
77 }
78 Stdio_MMT_List_Type;
79 
80 struct _pSLFile_FD_Type
81 {
82    char *name;
83    unsigned int num_refs;	       /* reference counting */
84    int fd;			       /* used if get_fd method is NULL */
85 
86    Stdio_MMT_List_Type *stdio_mmt_list;/* fdopen'd stdio objects */
87 
88    int is_closed;		       /* non-zero if closed */
89 
90 #define _SLFD_NO_AUTO_CLOSE	1
91    unsigned int flags;
92 
93    /* methods */
94    int clientdata_id;
95    VOID_STAR clientdata;
96    void (*free_client_data)(VOID_STAR);
97 
98    int (*get_fd) (VOID_STAR, int *);
99    /* If non-NULL, get_fd will be used to obtain the descriptor when needed */
100 
101    int (*close) (VOID_STAR);
102    int (*read)(VOID_STAR, char *, unsigned int);
103    int (*write)(VOID_STAR, char *, unsigned int);
104    SLFile_FD_Type *(*dup)(VOID_STAR);
105 
106    SLFile_FD_Type *next;	       /* next in the list */
107 };
108 
get_fd(SLFile_FD_Type * f,int * fdp)109 static int get_fd (SLFile_FD_Type *f, int *fdp)
110 {
111    if (f->is_closed == 0)
112      {
113 	if (f->get_fd == NULL)
114 	  {
115 	     *fdp = f->fd;
116 	     return 0;
117 	  }
118 
119 	if (0 == (*f->get_fd)(f->clientdata, fdp))
120 	  return 0;
121      }
122    *fdp = -1;
123 #ifdef EBADF
124    SLerrno_set_errno (EBADF);
125 #endif
126    return -1;
127 }
128 
129 static SLFile_FD_Type *FD_Type_List = NULL;
130 
chain_fd_type(SLFile_FD_Type * f)131 static void chain_fd_type (SLFile_FD_Type *f)
132 {
133    f->next = FD_Type_List;
134    FD_Type_List = f;
135 }
136 
unchain_fdtype(SLFile_FD_Type * f)137 static void unchain_fdtype (SLFile_FD_Type *f)
138 {
139    SLFile_FD_Type *curr;
140 
141    curr = FD_Type_List;
142    if (curr == f)
143      {
144 	FD_Type_List = f->next;
145 	return;
146      }
147 
148    while (curr != NULL)
149      {
150 	SLFile_FD_Type *prev = curr;
151 	curr = curr->next;
152 	if (curr == f)
153 	  {
154 	     prev->next = f->next;
155 	     return;
156 	  }
157      }
158 }
159 
find_chained_fd(int fd)160 static SLFile_FD_Type *find_chained_fd (int fd)
161 {
162    SLFile_FD_Type *f;
163 
164    f = FD_Type_List;
165    while (f != NULL)
166      {
167 	int fd1;
168 
169 	if ((0 == get_fd (f, &fd1))
170 	    && (fd1 == fd))
171 	  return f;
172 
173 	f = f->next;
174      }
175 
176    return NULL;
177 }
178 
179 /* This function gets called when the fclose intrinsic is called on an fdopen
180  * derived object.
181  */
_pSLfclose_fdopen_fp(SLang_MMT_Type * mmt)182 void _pSLfclose_fdopen_fp (SLang_MMT_Type *mmt)
183 {
184    SLFile_FD_Type *f;
185 
186    f = FD_Type_List;
187    while (f != NULL)
188      {
189 	Stdio_MMT_List_Type *prev, *curr;
190 
191 	prev = NULL;
192 	curr = f->stdio_mmt_list;
193 	while (curr != NULL)
194 	  {
195 	     if (curr->stdio_mmt != mmt)
196 	       {
197 		  prev = curr;
198 		  curr = curr->next;
199 		  continue;
200 	       }
201 
202 	     if (prev == NULL)
203 	       f->stdio_mmt_list = curr->next;
204 	     else
205 	       prev->next = curr->next;
206 
207 	     SLang_free_mmt (mmt);
208 	     SLfree ((char *) curr);
209 	     /* Do not attempt to close the descriptor since fclose did it.
210 	      * This avoids a problem if a new descriptor with the same fd
211 	      * has been created before this has been called, e.g.,
212 	      * fd = open(); fp = fdopen(fd); fclose(fp); fd = open();
213 	      * The last open is the problem, since it is equive to the following:
214 	      *   tmp = open(); close(fd); fd = tmp;
215 	      * Here, after the first open, tmp may be set to the same integer
216 	      * as fd.
217 	      */
218 	     f->is_closed = 1;
219 	     return;
220 	  }
221 	f = f->next;
222      }
223 }
224 
free_stdio_mmts(SLFile_FD_Type * f)225 static void free_stdio_mmts (SLFile_FD_Type *f)
226 {
227    Stdio_MMT_List_Type *curr = f->stdio_mmt_list;
228 
229    while (curr != NULL)
230      {
231 	Stdio_MMT_List_Type *next = curr->next;
232 	SLang_free_mmt (curr->stdio_mmt);
233 	SLfree ((char *) curr);
234 	curr = next;
235      }
236    f->stdio_mmt_list = NULL;
237 }
238 
alloc_stdio_list_elem(void)239 static Stdio_MMT_List_Type *alloc_stdio_list_elem (void)
240 {
241    Stdio_MMT_List_Type *elem;
242 
243    elem = (Stdio_MMT_List_Type *) SLmalloc(sizeof(Stdio_MMT_List_Type));
244    if (elem != NULL)
245      memset ((char *)elem, 0, sizeof (Stdio_MMT_List_Type));
246    return elem;
247 }
248 
249 /* Returns 0 the system call should not be restarted, 1 otherwise */
is_interrupt(int e,int check_eagain)250 static int is_interrupt (int e, int check_eagain)
251 {
252    SLerrno_set_errno (e);
253 
254 #ifdef EINTR
255    if (e == EINTR)
256      {
257 	if (0 == SLang_handle_interrupt ())
258 	  return 1;
259      }
260 #endif
261 #ifdef EAGAIN
262    if (e == EAGAIN)
263      {
264 	if (check_eagain
265 	    && (0 == SLang_handle_interrupt ()))
266 	  return 1;
267      }
268 #endif
269    return 0;
270 }
271 
do_close(SLFile_FD_Type * f)272 static int do_close (SLFile_FD_Type *f)
273 {
274    int fd;
275    int status;
276 
277    if (-1 == get_fd (f, &fd))
278      return -1;
279 
280    errno = 0;
281    if (f->close != NULL)
282      status = (*f->close)(f->clientdata);
283    else
284      status = close (fd);
285 
286    if (status == 0)
287      {
288 	f->fd = -1;
289 	f->is_closed = 1;
290 	if ((f->clientdata != NULL) && (f->free_client_data != NULL))
291 	  (*f->free_client_data) (f->clientdata);
292 	f->clientdata = NULL;
293 	return status;
294      }
295 
296    /* see http://lwn.net/Articles/576478/ */
297    if (0 == is_interrupt (errno, 1))
298      return -1;
299 
300    return 0;
301 }
302 
do_write(SLFile_FD_Type * f,char * buf,SLstrlen_Type * nump)303 static int do_write (SLFile_FD_Type *f, char *buf, SLstrlen_Type *nump)
304 {
305    int fd;
306 
307    if (-1 == get_fd (f, &fd))
308      {
309 	*nump = 0;
310 	return -1;
311      }
312 
313    while (1)
314      {
315 	ssize_t num;
316 
317 	errno = 0;
318 	if (f->write != NULL)
319 	  num = (*f->write)(f->clientdata, buf, *nump);
320 	else
321 	  num = SLSYSWRAP_WRITE (fd, buf, *nump);
322 
323 	if (num != -1)
324 	  {
325 	     *nump = (unsigned int) num;
326 	     return 0;
327 	  }
328 
329 	if (is_interrupt (errno, 0))
330 	  continue;
331 
332 	*nump = 0;
333 	return -1;
334      }
335 }
336 
do_read(SLFile_FD_Type * f,char * buf,unsigned int * nump)337 static int do_read (SLFile_FD_Type *f, char *buf, unsigned int *nump)
338 {
339    int fd;
340 
341    if (-1 == get_fd (f, &fd))
342      {
343 	*nump = 0;
344 	return -1;
345      }
346 
347    while (1)
348      {
349 	int num;
350 
351 	errno = 0;
352 	if (f->read != NULL)
353 	  num = (*f->read)(f->clientdata, buf, *nump);
354 	else
355 	  num = SLSYSWRAP_READ (fd, buf, *nump);
356 
357 	if (num != -1)
358 	  {
359 	     *nump = (unsigned int) num;
360 	     return 0;
361 	  }
362 
363 	if (is_interrupt (errno, 0))
364 	  continue;
365 
366 	*nump = 0;
367 	return -1;
368      }
369 }
370 
posix_close_fd(int * fd)371 static int posix_close_fd (int *fd)
372 {
373    if (-1 == close (*fd))
374      {
375 	/* see http://lwn.net/Articles/576478/ */
376 	if (0 == is_interrupt (errno, 1))
377 	  return -1;
378      }
379    return 0;
380 }
381 
posix_close_slfd(SLFile_FD_Type * f)382 static int posix_close_slfd (SLFile_FD_Type *f)
383 {
384    int status = do_close (f);
385 
386    free_stdio_mmts (f);
387    return status;
388 }
389 
390 /* Usage: Uint write (f, buf); */
posix_write(SLFile_FD_Type * f,SLang_BString_Type * bstr)391 static void posix_write (SLFile_FD_Type *f, SLang_BString_Type *bstr)
392 {
393    SLstrlen_Type len;
394    char *p;
395 
396    if ((NULL == (p = (char *)SLbstring_get_pointer (bstr, &len)))
397        || (-1 == do_write (f, p, &len)))
398      {
399 	SLang_push_integer (-1);
400 	return;
401      }
402    (void) SLang_push_uinteger (len);
403 }
404 
405 /* Usage: nn = read (f, &buf, n); */
posix_read(SLFile_FD_Type * f,SLang_Ref_Type * ref,unsigned int * nbytes)406 static void posix_read (SLFile_FD_Type *f, SLang_Ref_Type *ref, unsigned int *nbytes)
407 {
408    unsigned int len;
409    char *b;
410    SLang_BString_Type *bstr;
411 
412    b = NULL;
413 
414    len = *nbytes;
415    if ((NULL == (b = (char *)SLmalloc (len + 1)))
416        || (-1 == do_read (f, b, &len)))
417      goto return_error;
418 
419    if (len != *nbytes)
420      {
421 	char *b1 = (char *)SLrealloc (b, len + 1);
422 	if (b1 == NULL)
423 	  goto return_error;
424 	b = b1;
425      }
426 
427    bstr = SLbstring_create_malloced ((unsigned char *) b, len, 0);
428    if (bstr != NULL)
429      {
430 	if (-1 == SLang_assign_to_ref (ref, SLANG_BSTRING_TYPE, (VOID_STAR)&bstr))
431 	  {
432 	     SLbstring_free (bstr);
433 	     return;
434 	  }
435 	SLbstring_free (bstr);
436 	(void) SLang_push_uinteger (len);
437 	return;
438      }
439 
440    return_error:
441    if (b != NULL) SLfree ((char *)b);
442    (void) SLang_assign_to_ref (ref, SLANG_NULL_TYPE, NULL);
443    (void) SLang_push_integer (-1);
444 }
445 
SLfile_create_fd(SLFUTURE_CONST char * name,int fd)446 SLFile_FD_Type *SLfile_create_fd (SLFUTURE_CONST char *name, int fd)
447 {
448    SLFile_FD_Type *f;
449 
450    if (name == NULL)
451      name = "";
452 
453    if (NULL == (f = (SLFile_FD_Type *) SLmalloc (sizeof (SLFile_FD_Type))))
454      return NULL;
455 
456    memset ((char *) f, 0, sizeof (SLFile_FD_Type));
457    if (NULL == (f->name = SLang_create_slstring (name)))
458      {
459 	SLfree ((char *)f);
460 	return NULL;
461      }
462 
463    f->fd = fd;
464    f->num_refs = 1;
465 
466    f->clientdata_id = 0;
467    f->clientdata = NULL;
468    /* If NULL, use the standard routines on a file descriptor */
469    f->close = NULL;
470    f->read = NULL;
471    f->write = NULL;
472 
473    chain_fd_type (f);
474 
475    return f;
476 }
477 
SLfile_set_getfd_method(SLFile_FD_Type * f,int (* func)(VOID_STAR,int *))478 int SLfile_set_getfd_method (SLFile_FD_Type *f, int (*func)(VOID_STAR, int *))
479 {
480    if (f == NULL)
481      return -1;
482    f->get_fd = func;
483    return 0;
484 }
485 
486 int Last_Client_Data_ID = 0;
SLfile_create_clientdata_id(int * idp)487 int SLfile_create_clientdata_id (int *idp)
488 {
489    if (Last_Client_Data_ID != -1)
490      Last_Client_Data_ID++;
491 
492    if (Last_Client_Data_ID == -1)
493      {
494 	*idp = -1;
495 	return -1;
496      }
497    *idp = Last_Client_Data_ID;
498    return 0;
499 }
500 
SLfile_get_clientdata(SLFile_FD_Type * f,int id,VOID_STAR * cdp)501 int SLfile_get_clientdata (SLFile_FD_Type *f, int id, VOID_STAR *cdp)
502 {
503    if ((f == NULL)
504        || (f->clientdata_id != id))
505      {
506 	*cdp = NULL;
507 	return -1;
508      }
509 
510    *cdp = f->clientdata;
511    return 0;
512 }
513 
SLfile_set_clientdata(SLFile_FD_Type * f,void (* func)(VOID_STAR),VOID_STAR cd,int id)514 int SLfile_set_clientdata (SLFile_FD_Type *f, void (*func)(VOID_STAR), VOID_STAR cd, int id)
515 {
516    if (f == NULL)
517      return -1;
518    if (id == -1)
519      {
520 	_pSLang_verror (SL_Application_Error, "SLfile_set_client_data: invalid id");
521 	return -1;
522      }
523 
524    f->free_client_data = func;
525    f->clientdata = cd;
526    f->clientdata_id = id;
527    return 0;
528 }
529 
SLfile_set_close_method(SLFile_FD_Type * f,int (* func)(VOID_STAR))530 int SLfile_set_close_method (SLFile_FD_Type *f, int (*func)(VOID_STAR))
531 {
532    if (f == NULL)
533      return -1;
534    f->close = func;
535    return 0;
536 }
537 
SLfile_set_read_method(SLFile_FD_Type * f,int (* func)(VOID_STAR,char *,unsigned int))538 int SLfile_set_read_method (SLFile_FD_Type *f, int (*func)(VOID_STAR, char*, unsigned int))
539 {
540    if (f == NULL)
541      return -1;
542    f->read = func;
543    return 0;
544 }
545 
SLfile_set_write_method(SLFile_FD_Type * f,int (* func)(VOID_STAR,char *,unsigned int))546 int SLfile_set_write_method (SLFile_FD_Type *f, int (*func)(VOID_STAR, char*, unsigned int))
547 {
548    if (f == NULL)
549      return -1;
550    f->write = func;
551    return 0;
552 }
553 
SLfile_set_dup_method(SLFile_FD_Type * f,SLFile_FD_Type * (* func)(VOID_STAR))554 int SLfile_set_dup_method (SLFile_FD_Type *f, SLFile_FD_Type *(*func)(VOID_STAR))
555 {
556    if (f == NULL)
557      return -1;
558    f->dup = func;
559    return 0;
560 }
561 
SLfile_dup_fd(SLFile_FD_Type * f0)562 SLFile_FD_Type *SLfile_dup_fd (SLFile_FD_Type *f0)
563 {
564    SLFile_FD_Type *f;
565    int fd0, fd;
566 
567    if (f0 == NULL)
568      return NULL;
569 
570    if (-1 == get_fd (f0, &fd0))
571      return NULL;
572 
573    if (f0->dup != NULL)
574      return (*f0->dup)(f0->clientdata);
575 
576    while (-1 == (fd = dup (fd0)))
577      {
578 	if (is_interrupt (errno, 1))
579 	  continue;
580 
581 	return NULL;
582      }
583 
584    if (NULL == (f = SLfile_create_fd (f0->name, fd)))
585      {
586 	(void) close (fd);
587 	return NULL;
588      }
589 
590    return f;
591 }
592 
593 /* Not yet a public function */
SLfile_dup2_fd(SLFile_FD_Type * f0,int newfd)594 static int SLfile_dup2_fd (SLFile_FD_Type *f0, int newfd)
595 {
596    int fd0, fd;
597 
598    if ((f0 == NULL)
599        || (-1 == get_fd (f0, &fd0)))
600      {
601 #ifdef EBADF
602 	SLerrno_set_errno (EBADF);
603 #endif
604 	return -1;
605      }
606 
607    while (-1 == (fd = dup2 (fd0, newfd)))
608      {
609 	if (is_interrupt (errno, 1))
610 	  continue;
611 
612 	return -1;
613      }
614    return fd;
615 }
616 
SLfile_get_fd(SLFile_FD_Type * f,int * fd)617 int SLfile_get_fd (SLFile_FD_Type *f, int *fd)
618 {
619    if (f == NULL)
620      return -1;
621 
622    return get_fd (f, fd);
623 }
624 
SLfile_free_fd(SLFile_FD_Type * f)625 void SLfile_free_fd (SLFile_FD_Type *f)
626 {
627    if (f == NULL)
628      return;
629 
630    if (f->num_refs > 1)
631      {
632 	f->num_refs -= 1;
633 	return;
634      }
635 
636    if (0 == (f->flags & _SLFD_NO_AUTO_CLOSE))
637      (void) do_close (f);
638 
639    if ((f->clientdata != NULL)
640        && (f->free_client_data != NULL))
641      (*f->free_client_data) (f->clientdata);
642 
643    free_stdio_mmts (f);
644 
645    unchain_fdtype (f);
646 
647    SLfree ((char *) f);
648 }
649 
pop_string_int(char ** s,int * i)650 static int pop_string_int (char **s, int *i)
651 {
652    *s = NULL;
653    if ((-1 == SLang_pop_integer (i))
654        || (-1 == SLang_pop_slstring (s)))
655      return -1;
656 
657    return 0;
658 }
659 
pop_string_int_int(char ** s,int * a,int * b)660 static int pop_string_int_int (char **s, int *a, int *b)
661 {
662    *s = NULL;
663    if ((-1 == SLang_pop_integer (b))
664        || (-1 == pop_string_int (s, a)))
665      return -1;
666 
667    return 0;
668 }
669 
posix_open(void)670 static void posix_open (void)
671 {
672    char *file;
673    int mode, flags;
674    SLFile_FD_Type *f;
675 
676    switch (SLang_Num_Function_Args)
677      {
678       case 3:
679 	if (-1 == pop_string_int_int (&file, &flags, &mode))
680 	  {
681 	     SLang_push_null ();
682 	     return;
683 	  }
684 	break;
685 
686       case 2:
687       default:
688 	if (-1 == pop_string_int (&file, &flags))
689 	  return;
690 	mode = 0777;
691 	break;
692      }
693 
694    f = SLfile_create_fd (file, -1);
695    if (f == NULL)
696      {
697 	SLang_free_slstring (file);
698 	SLang_push_null ();
699 	return;
700      }
701    SLang_free_slstring (file);
702 
703    while (-1 == (f->fd = SLSYSWRAP_OPEN (f->name, flags, mode)))
704      {
705 	int e = errno;
706 	if (is_interrupt (errno, 1))
707 	  continue;
708 
709 	SLfile_free_fd (f);	       /* could affect errno */
710 	SLerrno_set_errno (e);
711 	SLang_push_null ();
712 	return;
713      }
714 
715    if (-1 == SLfile_push_fd (f))
716      SLang_push_null ();
717    SLfile_free_fd (f);
718 }
719 
dummy_close(VOID_STAR cd)720 static int dummy_close (VOID_STAR cd)
721 {
722    (void) cd;
723    return 0;
724 }
725 
posix_fileno_int(void)726 static int posix_fileno_int (void)
727 {
728    int fd;
729    SLFile_FD_Type *f;
730 
731    if (SLang_peek_at_stack () == SLANG_FILE_PTR_TYPE)
732      {
733 	SLang_MMT_Type *mmt;
734 	FILE *fp;
735 
736 	if (-1 == SLang_pop_fileptr (&mmt, &fp))
737 	  return -1;
738 
739 	fd = fileno (fp);
740 	SLang_free_mmt (mmt);
741 	return fd;
742      }
743 
744    if (-1 == SLfile_pop_fd (&f))
745      return -1;
746 
747    if (-1 == get_fd (f, &fd))
748      fd = -1;
749 
750    SLfile_free_fd (f);
751    return fd;
752 }
753 
posix_fileno(void)754 static void posix_fileno (void)
755 {
756    FILE *fp;
757    SLang_MMT_Type *mmt;
758    int fd;
759    SLFile_FD_Type *f;
760    SLFUTURE_CONST char *name;
761 
762    if (-1 == SLang_pop_fileptr (&mmt, &fp))
763      {
764 	SLang_push_null ();
765 	return;
766      }
767    name = SLang_get_name_from_fileptr (mmt);
768    fd = fileno (fp);
769 
770    f = SLfile_create_fd (name, fd);
771    if (f != NULL)
772      {
773 	/* prevent fd from being closed  when it goes out of scope */
774 	f->flags |= _SLFD_NO_AUTO_CLOSE;
775 	f->close = dummy_close;
776      }
777 
778    SLang_free_mmt (mmt);
779 
780    if (-1 == SLfile_push_fd (f))
781      SLang_push_null ();
782    SLfile_free_fd (f);
783 }
784 
posix_fdopen(SLFile_FD_Type * f,char * mode)785 static void posix_fdopen (SLFile_FD_Type *f, char *mode)
786 {
787    Stdio_MMT_List_Type *elem;
788 
789    if (NULL == (elem = alloc_stdio_list_elem ()))
790      return;
791 
792    if (-1 == _pSLstdio_fdopen (f->name, f->fd, mode))
793      {
794 	SLfree ((char *)elem);
795 	return;
796      }
797 
798    if (NULL == (elem->stdio_mmt = SLang_pop_mmt (SLANG_FILE_PTR_TYPE)))
799      {
800 	SLfree ((char *) elem);
801 	return;
802      }
803 
804    if (-1 == SLang_push_mmt (elem->stdio_mmt))
805      {
806 	SLfree ((char *) elem);
807 	return;
808      }
809 
810    elem->next = f->stdio_mmt_list;
811    f->stdio_mmt_list = elem;
812 }
813 
posix_lseek(SLFile_FD_Type * f,_pSLc_off_t_Type * ofs,int * whence)814 static void posix_lseek (SLFile_FD_Type *f, _pSLc_off_t_Type *ofs, int *whence)
815 {
816    _pSLc_off_t_Type status;
817    int fd;
818 
819    if (-1 == (status = get_fd (f, &fd)))
820      goto the_return;
821 
822    while (-1 == (status = lseek (fd, *ofs, *whence)))
823      {
824 	if (0 == is_interrupt (errno, 1))
825 	  break;
826      }
827 
828 the_return:
829 
830    (void) SLANG_PUSH_OFF_T (status);
831 }
832 
pop_fd(int * fdp,SLFile_FD_Type ** fp,SLang_MMT_Type ** mmtp)833 static int pop_fd (int *fdp, SLFile_FD_Type **fp, SLang_MMT_Type **mmtp)
834 {
835    int fd;
836 
837    *fp = NULL; *mmtp = NULL;
838 
839    switch (SLang_peek_at_stack ())
840      {
841       case SLANG_FILE_PTR_TYPE:
842 	  {
843 	     SLang_MMT_Type *mmt;
844 	     FILE *p;
845 
846 	     if (-1 == SLang_pop_fileptr (&mmt, &p))
847 	       return -1;
848 	     fd = fileno (p);
849 	     *mmtp = mmt;
850 	  }
851 	break;
852 
853       case SLANG_FILE_FD_TYPE:
854 	  {
855 	     SLFile_FD_Type *f;
856 	     if (-1 == SLfile_pop_fd (&f))
857 	       return -1;
858 	     if (-1 == get_fd (f, &fd))
859 	       {
860 		  SLfile_free_fd (f);
861 		  return -1;
862 	       }
863 	  }
864 	break;
865 
866       default:
867 	if (-1 == SLang_pop_int (&fd))
868 	  return -1;
869      }
870    *fdp = fd;
871    return 0;
872 }
873 
posix_isatty(void)874 static int posix_isatty (void)
875 {
876    int ret;
877    SLFile_FD_Type *f;
878    SLang_MMT_Type *mmt;
879    int fd;
880 
881    if (-1 == pop_fd (&fd, &f, &mmt))
882      return 0;		       /* invalid descriptor */
883 
884    if (0 == (ret = isatty (fd)))
885      _pSLerrno_errno = errno;
886 
887    if (mmt != NULL) SLang_free_mmt (mmt);
888    if (f != NULL) SLfile_free_fd (f);
889 
890    return ret;
891 }
892 
893 #ifdef HAVE_TTYNAME_R
894 /* Older POSIX standards had a different interface for this.  Avoid it. */
895 # if !defined(_POSIX_C_SOURCE) || (_POSIX_C_SOURCE < 199506L)
896 #  undef HAVE_TTYNAME_R
897 # endif
898 #endif
899 
900 #ifdef HAVE_TTYNAME_R
901 # define TTYNAME_R ttyname_r
902 #else
903 # ifdef HAVE_TTYNAME
904 #  define TTYNAME_R my_ttyname_r
my_ttyname_r(int fd,char * buf,size_t buflen)905 static int my_ttyname_r (int fd, char *buf, size_t buflen)
906 {
907    char *tty = ttyname (fd);
908    if (tty == NULL)
909      {
910 	int e = errno;
911 	if (e == 0)
912 	  e = -1;
913 	return e;
914      }
915    strncpy (buf, tty, buflen);
916    buf[buflen-1] = 0;
917    return 0;
918 }
919 # endif
920 #endif
921 
922 #ifdef TTYNAME_R
posix_ttyname(void)923 static void posix_ttyname (void)
924 {
925    SLFile_FD_Type *f;
926    SLang_MMT_Type *mmt;
927    int fd;
928    char buf[512];
929    int e;
930 
931    if (SLang_Num_Function_Args == 0)
932      {
933 	fd = 0;
934 	f = NULL;
935 	mmt = NULL;
936      }
937    else if (-1 == pop_fd (&fd, &f, &mmt))
938      return;
939 
940    if (0 != (e = TTYNAME_R (fd, buf, sizeof(buf))))
941      {
942 	_pSLerrno_errno = e;
943 	SLang_push_null ();
944      }
945    else
946      (void) SLang_push_string (buf);
947 
948    if (mmt != NULL) SLang_free_mmt (mmt);
949    if (f != NULL) SLfile_free_fd (f);
950 }
951 #endif
952 
posix_dup(SLFile_FD_Type * f)953 static void posix_dup (SLFile_FD_Type *f)
954 {
955    if ((NULL == (f = SLfile_dup_fd (f)))
956        || (-1 == SLfile_push_fd (f)))
957      SLang_push_null ();
958 
959    SLfile_free_fd (f);
960 }
961 
posix_dup2(SLFile_FD_Type * f,int * new_fd)962 static int posix_dup2 (SLFile_FD_Type *f, int *new_fd)
963 {
964    return SLfile_dup2_fd (f, *new_fd);
965 }
966 
fdtype_datatype_deref(SLtype type)967 static int fdtype_datatype_deref (SLtype type)
968 {
969    SLFile_FD_Type *f;
970    int status;
971    int fd;
972 
973    (void) type;
974 
975    if (-1 == SLang_pop_int (&fd))
976      return -1;
977 #ifdef F_GETFL
978    while (-1 == fcntl (fd, F_GETFL))
979      {
980 	if (is_interrupt (errno, 1))
981 	  continue;
982 
983 	return SLang_push_null ();
984      }
985 #endif
986    f = find_chained_fd (fd);
987    if (f != NULL)
988      return SLfile_push_fd (f);
989 
990    /* The descriptor is valid, but we have no record of what it is.  So make sure
991     * it is not automatically closed.
992     */
993    if (NULL == (f = SLfile_create_fd (NULL, fd)))
994      return -1;
995    f->flags |= _SLFD_NO_AUTO_CLOSE;
996 
997    status = SLfile_push_fd (f);
998    SLfile_free_fd (f);
999    return status;
1000 }
1001 
1002 #define I SLANG_INT_TYPE
1003 #define V SLANG_VOID_TYPE
1004 #define F SLANG_FILE_FD_TYPE
1005 #define B SLANG_BSTRING_TYPE
1006 #define R SLANG_REF_TYPE
1007 #define U SLANG_UINT_TYPE
1008 #define S SLANG_STRING_TYPE
1009 #define L SLANG_LONG_TYPE
1010 static SLang_Intrin_Fun_Type Fd_Name_Table [] =
1011 {
1012    MAKE_INTRINSIC_0("fileno", posix_fileno, V),
1013    MAKE_INTRINSIC_0("_fileno", posix_fileno_int, I),
1014    MAKE_INTRINSIC_0("isatty", posix_isatty, I),
1015    MAKE_INTRINSIC_0("open", posix_open, V),
1016    MAKE_INTRINSIC_3("read", posix_read, V, F, R, U),
1017    MAKE_INTRINSIC_3("lseek", posix_lseek, V, F, SLANG_C_OFF_T_TYPE, I),
1018    MAKE_INTRINSIC_2("fdopen", posix_fdopen, V, F, S),
1019    MAKE_INTRINSIC_2("write", posix_write, V, F, B),
1020    MAKE_INTRINSIC_1("dup_fd", posix_dup, V, F),
1021    MAKE_INTRINSIC_2("dup2_fd", posix_dup2, I, F, I),
1022    MAKE_INTRINSIC_1("close", posix_close_slfd, I, F),
1023    MAKE_INTRINSIC_1("_close", posix_close_fd, I, I),
1024 #if defined(TTYNAME_R)
1025    MAKE_INTRINSIC_0("ttyname", posix_ttyname, V),
1026 #endif
1027    SLANG_END_INTRIN_FUN_TABLE
1028 };
1029 #undef I
1030 #undef V
1031 #undef F
1032 #undef B
1033 #undef R
1034 #undef S
1035 #undef L
1036 #undef U
1037 
1038 static SLang_IConstant_Type PosixIO_Consts [] =
1039 {
1040 #ifdef O_RDONLY
1041    MAKE_ICONSTANT("O_RDONLY", O_RDONLY),
1042 #endif
1043 #ifdef O_WRONLY
1044    MAKE_ICONSTANT("O_WRONLY", O_WRONLY),
1045 #endif
1046 #ifdef O_RDWR
1047    MAKE_ICONSTANT("O_RDWR", O_RDWR),
1048 #endif
1049 #ifdef O_APPEND
1050    MAKE_ICONSTANT("O_APPEND", O_APPEND),
1051 #endif
1052 #ifdef O_CREAT
1053    MAKE_ICONSTANT("O_CREAT", O_CREAT),
1054 #endif
1055 #ifdef O_EXCL
1056    MAKE_ICONSTANT("O_EXCL", O_EXCL),
1057 #endif
1058 #ifdef O_NOCTTY
1059    MAKE_ICONSTANT("O_NOCTTY", O_NOCTTY),
1060 #endif
1061 #ifdef O_NONBLOCK
1062    MAKE_ICONSTANT("O_NONBLOCK", O_NONBLOCK),
1063 #endif
1064 #ifdef O_TRUNC
1065    MAKE_ICONSTANT("O_TRUNC", O_TRUNC),
1066 #endif
1067 #ifndef O_BINARY
1068 # define O_BINARY 0
1069 #endif
1070    MAKE_ICONSTANT("O_BINARY", O_BINARY),
1071 #ifndef O_TEXT
1072 # define O_TEXT 0
1073 #endif
1074    MAKE_ICONSTANT("O_TEXT", O_TEXT),
1075 #ifdef O_LARGEFILE
1076    MAKE_ICONSTANT("O_LARGEFILE", O_LARGEFILE),
1077 #endif
1078    SLANG_END_ICONST_TABLE
1079 };
1080 
SLfile_push_fd(SLFile_FD_Type * f)1081 int SLfile_push_fd (SLFile_FD_Type *f)
1082 {
1083    if (f == NULL)
1084      return SLang_push_null ();
1085 
1086    f->num_refs += 1;
1087 
1088    if (0 == SLclass_push_ptr_obj (SLANG_FILE_FD_TYPE, (VOID_STAR) f))
1089      return 0;
1090 
1091    f->num_refs -= 1;
1092 
1093    return -1;
1094 }
1095 
SLfile_pop_fd(SLFile_FD_Type ** f)1096 int SLfile_pop_fd (SLFile_FD_Type **f)
1097 {
1098    return SLclass_pop_ptr_obj (SLANG_FILE_FD_TYPE, (VOID_STAR *) f);
1099 }
1100 
destroy_fd_type(SLtype type,VOID_STAR ptr)1101 static void destroy_fd_type (SLtype type, VOID_STAR ptr)
1102 {
1103    /* Avoid setting errno when a variable goes out of scope */
1104    int e = _pSLerrno_errno;
1105 
1106    (void) type;
1107 
1108    SLfile_free_fd (*(SLFile_FD_Type **) ptr);
1109    _pSLerrno_errno = e;
1110 }
1111 
fd_push(SLtype type,VOID_STAR v)1112 static int fd_push (SLtype type, VOID_STAR v)
1113 {
1114    (void) type;
1115    return SLfile_push_fd (*(SLFile_FD_Type **)v);
1116 }
1117 
1118 static int
fd_fd_bin_op_result(int op,SLtype a,SLtype b,SLtype * c)1119 fd_fd_bin_op_result (int op, SLtype a, SLtype b,
1120 			     SLtype *c)
1121 {
1122    (void) a;
1123    (void) b;
1124    switch (op)
1125      {
1126       default:
1127 	return 0;
1128 
1129 #if 0
1130       case SLANG_GT:
1131       case SLANG_GE:
1132       case SLANG_LT:
1133       case SLANG_LE:
1134 #endif
1135       case SLANG_EQ:
1136       case SLANG_NE:
1137 	*c = SLANG_CHAR_TYPE;
1138 	break;
1139      }
1140    return 1;
1141 }
1142 
1143 static int
fd_fd_bin_op(int op,SLtype a_type,VOID_STAR ap,SLuindex_Type na,SLtype b_type,VOID_STAR bp,SLuindex_Type nb,VOID_STAR cp)1144 fd_fd_bin_op (int op,
1145 		      SLtype a_type, VOID_STAR ap, SLuindex_Type na,
1146 		      SLtype b_type, VOID_STAR bp, SLuindex_Type nb,
1147 		      VOID_STAR cp)
1148 {
1149    char *ic;
1150    SLFile_FD_Type **a, **b;
1151    SLuindex_Type n, n_max;
1152    SLuindex_Type da, db;
1153 
1154    (void) a_type;
1155    (void) b_type;
1156 
1157    if (na == 1) da = 0; else da = 1;
1158    if (nb == 1) db = 0; else db = 1;
1159 
1160    if (na > nb) n_max = na; else n_max = nb;
1161 
1162    a = (SLFile_FD_Type **) ap;
1163    b = (SLFile_FD_Type **) bp;
1164    ic = (char *) cp;
1165 
1166    switch (op)
1167      {
1168       case SLANG_NE:
1169 	for (n = 0; n < n_max; n++)
1170 	  {
1171 	     if ((*a == NULL) || (*b == NULL))
1172 	       ic [n] = (*a != *b);
1173 	     else
1174 	       ic [n] = (*a)->fd != (*b)->fd;
1175 	     a += da;
1176 	     b += db;
1177 	  }
1178 	break;
1179       case SLANG_EQ:
1180 	for (n = 0; n < n_max; n++)
1181 	  {
1182 	     if ((*a == NULL) || (*b == NULL))
1183 	       ic [n] = (*a == *b);
1184 	     else
1185 	       ic [n] = (*a)->fd == (*b)->fd;
1186 	     a += da;
1187 	     b += db;
1188 	  }
1189 	break;
1190 
1191       default:
1192 	return 0;
1193      }
1194    return 1;
1195 }
1196 
SLang_init_posix_io(void)1197 int SLang_init_posix_io (void)
1198 {
1199    SLang_Class_Type *cl;
1200 
1201    if (NULL == (cl = SLclass_allocate_class ("FD_Type")))
1202      return -1;
1203    cl->cl_destroy = destroy_fd_type;
1204    (void) SLclass_set_push_function (cl, fd_push);
1205    cl->cl_datatype_deref = fdtype_datatype_deref;
1206 
1207    if ((-1 == SLclass_register_class (cl, SLANG_FILE_FD_TYPE, sizeof (SLFile_FD_Type), SLANG_CLASS_TYPE_PTR))
1208        || (-1 == SLclass_add_binary_op (SLANG_FILE_FD_TYPE, SLANG_FILE_FD_TYPE, fd_fd_bin_op, fd_fd_bin_op_result)))
1209      return -1;
1210 
1211    if ((-1 == SLadd_intrin_fun_table(Fd_Name_Table, "__POSIXIO__"))
1212        || (-1 == SLadd_iconstant_table (PosixIO_Consts, NULL))
1213        || (-1 == _pSLerrno_init ()))
1214      return -1;
1215 
1216    return 0;
1217 }
1218 
1219