perl 5.0 alpha 3
[perl.git] / do / spair
1 #ifdef HAS_SOCKET
2 int
3 do_spair(stab1, stab2, arglast)
4 STAB *stab1;
5 STAB *stab2;
6 int *arglast;
7 {
8     register STR **st = stack->ary_array;
9     register int sp = arglast[2];
10     register STIO *stio1;
11     register STIO *stio2;
12     int domain, type, protocol, fd[2];
13
14     if (!stab1 || !stab2)
15         return FALSE;
16
17     stio1 = stab_io(stab1);
18     stio2 = stab_io(stab2);
19     if (!stio1)
20         stio1 = stab_io(stab1) = stio_new();
21     else if (stio1->ifp)
22         do_close(stab1,FALSE);
23     if (!stio2)
24         stio2 = stab_io(stab2) = stio_new();
25     else if (stio2->ifp)
26         do_close(stab2,FALSE);
27
28     domain = (int)str_gnum(st[++sp]);
29     type = (int)str_gnum(st[++sp]);
30     protocol = (int)str_gnum(st[++sp]);
31 TAINT_PROPER("in socketpair");
32 #ifdef HAS_SOCKETPAIR
33     if (socketpair(domain,type,protocol,fd) < 0)
34         return FALSE;
35 #else
36     fatal("Socketpair unimplemented");
37 #endif
38     stio1->ifp = fdopen(fd[0], "r");
39     stio1->ofp = fdopen(fd[0], "w");
40     stio1->type = 's';
41     stio2->ifp = fdopen(fd[1], "r");
42     stio2->ofp = fdopen(fd[1], "w");
43     stio2->type = 's';
44     if (!stio1->ifp || !stio1->ofp || !stio2->ifp || !stio2->ofp) {
45         if (stio1->ifp) fclose(stio1->ifp);
46         if (stio1->ofp) fclose(stio1->ofp);
47         if (!stio1->ifp && !stio1->ofp) close(fd[0]);
48         if (stio2->ifp) fclose(stio2->ifp);
49         if (stio2->ofp) fclose(stio2->ofp);
50         if (!stio2->ifp && !stio2->ofp) close(fd[1]);
51         return FALSE;
52     }
53
54     return TRUE;
55 }
56