Mercurial > hg > xemacs-beta

comparison src/sysdep.c @ 209:41ff10fd062f r20-4b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b3
author cvs
date Mon, 13 Aug 2007 10:04:58 +0200
parents 850242ba4a81
children 78478c60bfcd
comparison
equal deleted inserted replaced
208:f427b8ec4379 209:41ff10fd062f
75 #define _P_WAIT 0 75 #define _P_WAIT 0
76 int _CRTAPI1 _spawnlp (int, const char *, const char *, ...); 76 int _CRTAPI1 _spawnlp (int, const char *, const char *, ...);
77 int _CRTAPI1 _getpid (void); 77 int _CRTAPI1 _getpid (void);
78 #endif 78 #endif
79 79
80 /* ------------------------------- */
81 /* VMS includes */
82 /* ------------------------------- */
83
84 #ifdef VMS
85 #include <ttdef.h>
86 #include <tt2def.h>
87 #include <iodef.h>
88 #include <ssdef.h>
89 #include <descrip.h>
90 #include <fibdef.h>
91 #include <atrdef.h>
92 #undef F_SETFL
93 #ifndef RAB/*$C_BID -- suppress compiler warnings */
94 #include <rab.h>
95 #endif
96 #define MAXIOSIZE (32 * PAGESIZE) /* Don't I/O more than 32 blocks at a time */
97 #endif /* VMS */
98 80
99 /* ------------------------------- */ 81 /* ------------------------------- */
100 /* TTY definitions */ 82 /* TTY definitions */
101 /* ------------------------------- */ 83 /* ------------------------------- */
102 84
252 Since hardly any systems don't have subprocess support, 234 Since hardly any systems don't have subprocess support,
253 however, there doesn't seem to be much point. */ 235 however, there doesn't seem to be much point. */
254 if (wait (0) == pid) 236 if (wait (0) == pid)
255 return; 237 return;
256 } 238 }
257 #elif defined (VMS)
258 int status = SYS$FORCEX (&pid, 0, 0);
259 return;
260
261 #elif defined (HAVE_WAITPID) 239 #elif defined (HAVE_WAITPID)
262 /* Note that, whenever any subprocess terminates (asynch. or synch.), 240 /* Note that, whenever any subprocess terminates (asynch. or synch.),
263 the SIGCHLD handler will be called and it will call wait(). Thus 241 the SIGCHLD handler will be called and it will call wait(). Thus
264 we cannot just call wait() ourselves, and we can't block SIGCHLD 242 we cannot just call wait() ourselves, and we can't block SIGCHLD
265 and then call wait(), because then if an asynch. process dies 243 and then call wait(), because then if an asynch. process dies
419 and nonzero means something different. */ 397 and nonzero means something different. */
420 ioctl (channel, TIOCFLUSH, &zero); 398 ioctl (channel, TIOCFLUSH, &zero);
421 #endif 399 #endif
422 } 400 }
423 401
424 #ifndef VMS
425 #ifndef MSDOS 402 #ifndef MSDOS
426 #ifndef WINDOWSNT 403 #ifndef WINDOWSNT
427 /* Set up the terminal at the other end of a pseudo-terminal that 404 /* Set up the terminal at the other end of a pseudo-terminal that
428 we will be controlling an inferior through. 405 we will be controlling an inferior through.
429 It should not echo or do line-editing, since that is done 406 It should not echo or do line-editing, since that is done
531 } 508 }
532 #endif /* RTU */ 509 #endif /* RTU */
533 } 510 }
534 #endif /* WINDOWSNT */ 511 #endif /* WINDOWSNT */
535 #endif /* not MSDOS */ 512 #endif /* not MSDOS */
536 #endif /* not VMS */
537 513
538 #endif /* not NO_SUBPROCESSES */ 514 #endif /* not NO_SUBPROCESSES */
539 515
540 516
541 #if !defined (VMS) && !defined (SIGTSTP) && !defined (USG_JOBCTRL) 517 #if !defined (SIGTSTP) && !defined (USG_JOBCTRL)
542 518
543 /* Record a signal code and the handler for it. */ 519 /* Record a signal code and the handler for it. */
544 struct save_signal 520 struct save_signal
545 { 521 {
546 int code; 522 int code;
684 wait_for_termination (pid); 660 wait_for_termination (pid);
685 #endif 661 #endif
686 restore_signal_handlers (saved_handlers); 662 restore_signal_handlers (saved_handlers);
687 } 663 }
688 664
689 #endif /* !defined (VMS) && !defined (SIGTSTP) && !defined (USG_JOBCTRL) */ 665 #endif /* !defined (SIGTSTP) && !defined (USG_JOBCTRL) */
690 666
691 667
692 668
693 /* Suspend the Emacs process; give terminal to its superior. */ 669 /* Suspend the Emacs process; give terminal to its superior. */
694 void 670 void
695 sys_suspend (void) 671 sys_suspend (void)
696 { 672 {
697 #ifdef VMS 673 #if defined (SIGTSTP) && !defined (MSDOS)
698 /* "Foster" parentage allows emacs to return to a subprocess that attached
699 to the current emacs as a cheaper than starting a whole new process. This
700 is set up by KEPTEDITOR.COM. */
701 unsigned long parent_id, foster_parent_id;
702 char *fpid_string;
703
704 fpid_string = getenv ("EMACS_PARENT_PID");
705 if (fpid_string != NULL)
706 {
707 sscanf (fpid_string, "%x", &foster_parent_id);
708 if (foster_parent_id != 0)
709 parent_id = foster_parent_id;
710 else
711 parent_id = getppid ();
712 }
713 else
714 parent_id = getppid ();
715
716 xfree (fpid_string); /* On VMS, this was malloc'd */
717
718 if (parent_id && parent_id != 0xffffffff)
719 {
720 SIGTYPE (*oldsig)() = (int) signal (SIGINT, SIG_IGN);
721 int status = LIB$ATTACH (&parent_id) & 1;
722 signal (SIGINT, oldsig);
723 return status;
724 }
725 else
726 {
727 struct {
728 int l;
729 char *a;
730 } d_prompt;
731 d_prompt.l = sizeof ("Emacs: "); /* Our special prompt */
732 d_prompt.a = "Emacs: "; /* Just a reminder */
733 LIB$SPAWN (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, &d_prompt, 0);
734 return 1;
735 }
736 return -1;
737 #elif defined (SIGTSTP) && !defined (MSDOS)
738 { 674 {
739 int pgrp = EMACS_GET_PROCESS_GROUP (); 675 int pgrp = EMACS_GET_PROCESS_GROUP ();
740 EMACS_KILLPG (pgrp, SIGTSTP); 676 EMACS_KILLPG (pgrp, SIGTSTP);
741 } 677 }
742 678
886 822
887 #ifdef HAVE_TTY 823 #ifdef HAVE_TTY
888 assert (DEVICE_TTY_P (d)); 824 assert (DEVICE_TTY_P (d));
889 { 825 {
890 int input_fd = CONSOLE_TTY_DATA (con)->infd; 826 int input_fd = CONSOLE_TTY_DATA (con)->infd;
891 #ifdef MSDOS 827 #if defined (MSDOS) || defined(WIN32)
892 DEVICE_TTY_DATA (d)->ospeed = 15; 828 DEVICE_TTY_DATA (d)->ospeed = 15;
893 #elif defined (VMS)
894 struct vms_sensemode sg;
895
896 SYS$QIOW (0, input_fd, IO$_SENSEMODE, &sg, 0, 0,
897 &sg.class, 12, 0, 0, 0, 0 );
898 DEVICE_TTY_DATA (d)->ospeed = sg.xmit_baud;
899 #elif defined (HAVE_TERMIOS) 829 #elif defined (HAVE_TERMIOS)
900 struct termios sg; 830 struct termios sg;
901 831
902 sg.c_cflag = B9600; 832 sg.c_cflag = B9600;
903 tcgetattr (input_fd, &sg); 833 tcgetattr (input_fd, &sg);
915 tcgetattr (input_fd, &sg); 845 tcgetattr (input_fd, &sg);
916 # else 846 # else
917 ioctl (input_fd, TCGETA, &sg); 847 ioctl (input_fd, TCGETA, &sg);
918 # endif 848 # endif
919 DEVICE_TTY_DATA (d)->ospeed = sg.c_cflag & CBAUD; 849 DEVICE_TTY_DATA (d)->ospeed = sg.c_cflag & CBAUD;
920 #else /* neither VMS nor TERMIOS nor TERMIO */ 850 #else /* neither TERMIOS nor TERMIO */
921 struct sgttyb sg; 851 struct sgttyb sg;
922 852
923 sg.sg_ospeed = B9600; 853 sg.sg_ospeed = B9600;
924 if (ioctl (input_fd, TIOCGETP, &sg) < 0) 854 if (ioctl (input_fd, TIOCGETP, &sg) < 0)
925 abort (); 855 abort ();
1347 #ifdef HAVE_TCATTR 1277 #ifdef HAVE_TCATTR
1348 /* We have those nifty POSIX tcmumbleattr functions. */ 1278 /* We have those nifty POSIX tcmumbleattr functions. */
1349 if (tcgetattr (fd, &settings->main) < 0) 1279 if (tcgetattr (fd, &settings->main) < 0)
1350 return -1; 1280 return -1;
1351 1281
1352 #else 1282 #elif defined HAVE_TERMIO
1353 #ifdef HAVE_TERMIO
1354 /* The SYSV-style interface? */ 1283 /* The SYSV-style interface? */
1355 if (ioctl (fd, TCGETA, &settings->main) < 0) 1284 if (ioctl (fd, TCGETA, &settings->main) < 0)
1356 return -1; 1285 return -1;
1357 1286
1358 #else 1287 #elif !defined MSDOS && !defined(WIN32)
1359 #ifdef VMS
1360 /* Vehemently Monstrous System? :-) */
1361 if (! (SYS$QIOW (0, fd, IO$_SENSEMODE, settings, 0, 0,
1362 &settings->main.class, 12, 0, 0, 0, 0)
1363 & 1))
1364 return -1;
1365
1366 #else
1367 #ifndef MSDOS
1368 /* I give up - I hope you have the BSD ioctls. */ 1288 /* I give up - I hope you have the BSD ioctls. */
1369 if (ioctl (fd, TIOCGETP, &settings->main) < 0) 1289 if (ioctl (fd, TIOCGETP, &settings->main) < 0)
1370 return -1; 1290 return -1;
1371 #endif /* not MSDOS */
1372 #endif /* not VMS */
1373 #endif /* HAVE_TERMIO */
1374 #endif /* HAVE_TCATTR */ 1291 #endif /* HAVE_TCATTR */
1375 1292
1376 /* Suivant - Do we have to get struct ltchars data? */ 1293 /* Suivant - Do we have to get struct ltchars data? */
1377 #ifdef HAVE_LTCHARS 1294 #ifdef HAVE_LTCHARS
1378 if (ioctl (fd, TIOCGLTC, &settings->ltchars) < 0) 1295 if (ioctl (fd, TIOCGLTC, &settings->ltchars) < 0)
1433 && memcmp(new.c_cc, settings->main.c_cc, NCCS) == 0) 1350 && memcmp(new.c_cc, settings->main.c_cc, NCCS) == 0)
1434 break; 1351 break;
1435 else 1352 else
1436 continue; 1353 continue;
1437 } 1354 }
1438 #else 1355 #elif defined HAVE_TERMIO
1439 #ifdef HAVE_TERMIO
1440 /* The SYSV-style interface? */ 1356 /* The SYSV-style interface? */
1441 if (ioctl (fd, flushp ? TCSETAF : TCSETAW, &settings->main) < 0) 1357 if (ioctl (fd, flushp ? TCSETAF : TCSETAW, &settings->main) < 0)
1442 return -1; 1358 return -1;
1443 1359
1444 #else 1360 #elif !defined(MSDOS) && !defined(WIN32)
1445 #ifdef VMS
1446 /* Vehemently Monstrous System? :-) */
1447 if (! (SYS$QIOW (0, fd, IO$_SETMODE, &input_iosb, 0, 0,
1448 &settings->main.class, 12, 0, 0, 0, 0)
1449 & 1))
1450 return -1;
1451
1452 #else
1453 #ifndef MSDOS
1454 /* I give up - I hope you have the BSD ioctls. */ 1361 /* I give up - I hope you have the BSD ioctls. */
1455 if (ioctl (fd, (flushp) ? TIOCSETP : TIOCSETN, &settings->main) < 0) 1362 if (ioctl (fd, (flushp) ? TIOCSETP : TIOCSETN, &settings->main) < 0)
1456 return -1; 1363 return -1;
1457 #endif /* not MSDOS */
1458 #endif /* VMS */
1459 #endif /* HAVE_TERMIO */
1460 #endif /* HAVE_TCATTR */ 1364 #endif /* HAVE_TCATTR */
1461 1365
1462 /* Suivant - Do we have to get struct ltchars data? */ 1366 /* Suivant - Do we have to get struct ltchars data? */
1463 #ifdef HAVE_LTCHARS 1367 #ifdef HAVE_LTCHARS
1464 if (ioctl (fd, TIOCSLTC, &settings->ltchars) < 0) 1368 if (ioctl (fd, TIOCSLTC, &settings->ltchars) < 0)
1634 or via TELNET or the like, but does no harm elsewhere. */ 1538 or via TELNET or the like, but does no harm elsewhere. */
1635 tty.main.c_iflag &= ~IGNBRK; 1539 tty.main.c_iflag &= ~IGNBRK;
1636 tty.main.c_iflag &= ~BRKINT; 1540 tty.main.c_iflag &= ~BRKINT;
1637 #endif /* AIX */ 1541 #endif /* AIX */
1638 #else /* if not HAVE_TERMIO */ 1542 #else /* if not HAVE_TERMIO */
1639 #ifndef MSDOS 1543 #if !defined(MSDOS) && !defined(WIN32)
1640 con->tty_erase_char = make_char (tty.main.sg_erase); 1544 con->tty_erase_char = make_char (tty.main.sg_erase);
1641 tty.main.sg_flags &= ~(ECHO | CRMOD | XTABS); 1545 tty.main.sg_flags &= ~(ECHO | CRMOD | XTABS);
1642 if (TTY_FLAGS (con).meta_key) 1546 if (TTY_FLAGS (con).meta_key)
1643 tty.main.sg_flags |= ANYP; 1547 tty.main.sg_flags |= ANYP;
1644 /* #### should we be using RAW mode here? */ 1548 /* #### should we be using RAW mode here? */
1645 tty.main.sg_flags |= /* interrupt_input ? RAW : */ CBREAK; 1549 tty.main.sg_flags |= /* interrupt_input ? RAW : */ CBREAK;
1646 #endif /* not MSDOS */ 1550 #endif /* not MSDOS or WIN32 */
1647 #endif /* not HAVE_TERMIO */ 1551 #endif /* not HAVE_TERMIO */
1648 1552
1649 /* If going to use CBREAK mode, we must request C-g to interrupt 1553 /* If going to use CBREAK mode, we must request C-g to interrupt
1650 and turn off start and stop chars, etc. If not going to use 1554 and turn off start and stop chars, etc. If not going to use
1651 CBREAK mode, do this anyway so as to turn off local flow 1555 CBREAK mode, do this anyway so as to turn off local flow
1718 write (output_fd, "\033[20l", 5); 1622 write (output_fd, "\033[20l", 5);
1719 } 1623 }
1720 #endif 1624 #endif
1721 #endif 1625 #endif
1722 1626
1723 #ifdef VMS
1724 /* Appears to do nothing when in PASTHRU mode.
1725 SYS$QIOW (0, input_fd, IO$_SETMODE|IO$M_OUTBAND, 0, 0, 0,
1726 interrupt_signal, oob_chars, 0, 0, 0, 0);
1727 */
1728 queue_kbd_input (0);
1729 #endif /* VMS */
1730
1731 #if 0 /* We do our own buffering with lstreams. */ 1627 #if 0 /* We do our own buffering with lstreams. */
1732 #ifdef _IOFBF 1628 #ifdef _IOFBF
1733 /* This symbol is defined on recent USG systems. 1629 /* This symbol is defined on recent USG systems.
1734 Someone says without this call USG won't really buffer the file 1630 Someone says without this call USG won't really buffer the file
1735 even with a call to setbuf. */ 1631 even with a call to setbuf. */
1832 { 1728 {
1833 *widthp = size.ws_col; 1729 *widthp = size.ws_col;
1834 *heightp = size.ws_row; 1730 *heightp = size.ws_row;
1835 } 1731 }
1836 } 1732 }
1837 #else 1733 #elif defined TIOCGSIZE
1838 #ifdef TIOCGSIZE
1839 { 1734 {
1840 /* SunOS - style. */ 1735 /* SunOS - style. */
1841 struct ttysize size; 1736 struct ttysize size;
1842 1737
1843 if (ioctl (input_fd, TIOCGSIZE, &size) == -1) 1738 if (ioctl (input_fd, TIOCGSIZE, &size) == -1)
1846 { 1741 {
1847 *widthp = size.ts_cols; 1742 *widthp = size.ts_cols;
1848 *heightp = size.ts_lines; 1743 *heightp = size.ts_lines;
1849 } 1744 }
1850 } 1745 }
1851 #else 1746 #elif defined MSDOS
1852 #ifdef VMS
1853 {
1854 struct vms_sensemode tty;
1855
1856 SYS$QIOW (0, input_fd, IO$_SENSEMODE, &tty, 0, 0,
1857 &tty.class, 12, 0, 0, 0, 0);
1858 *widthp = tty.scr_wid;
1859 *heightp = tty.scr_len;
1860 }
1861 #else
1862 #ifdef MSDOS
1863
1864 *widthp = FrameCols (); 1747 *widthp = FrameCols ();
1865 *heightp = FrameRows (); 1748 *heightp = FrameRows ();
1866 1749
1867 #else /* system doesn't know size */ 1750 #else /* system doesn't know size */
1868 1751
1869 *widthp = 0; 1752 *widthp = 0;
1870 *heightp = 0; 1753 *heightp = 0;
1871 1754
1872 #endif /* not MSDOS */ 1755 #endif /* not !TIOCGWINSZ */
1873 #endif /* not VMS */
1874 #endif /* not SunOS-style */
1875 #endif /* not BSD-style */
1876 } 1756 }
1877 1757
1878 #endif /* HAVE_TTY */ 1758 #endif /* HAVE_TTY */
1879 1759
1880 1760
1961 1841
1962 #ifdef AIXHFT 1842 #ifdef AIXHFT
1963 hft_reset (con); 1843 hft_reset (con);
1964 #endif 1844 #endif
1965 1845
1966 #ifdef VMS
1967 stop_vms_input (con);
1968 #endif
1969 } 1846 }
1970 1847
1971 #endif /* HAVE_TTY */ 1848 #endif /* HAVE_TTY */
1972 1849
1973 void 1850 void
2139 } 2016 }
2140 2017
2141 #endif /* AIXHFT */ 2018 #endif /* AIXHFT */
2142 2019
2143 2020
2144 /* ------------------------------------------------------ */
2145 /* TTY stuff under VMS */
2146 /* ------------------------------------------------------ */
2147
2148 /***** #### this is all broken ****/
2149
2150 #ifdef VMS
2151
2152 /* Assigning an input channel is done at the start of Emacs execution.
2153 This is called each time Emacs is resumed, also, but does nothing
2154 because input_chain is no longer zero. */
2155
2156 void
2157 init_vms_input (void)
2158 {
2159 /* #### broken. */
2160 int status;
2161
2162 if (input_fd == 0)
2163 {
2164 status = SYS$ASSIGN (&vms_input_dsc, &input_fd, 0, 0);
2165 if (! (status & 1))
2166 LIB$STOP (status);
2167 }
2168 }
2169
2170 /* Deassigning the input channel is done before exiting. */
2171
2172 static void
2173 stop_vms_input (struct console *con)
2174 {
2175 int input_fd = CONSOLE_TTY_DATA (con)->infd;
2176 return SYS$DASSGN (input_fd);
2177 }
2178
2179 static short vms_input_buffer;
2180
2181 /* Request reading one character into the keyboard buffer.
2182 This is done as soon as the buffer becomes empty. */
2183
2184 static void
2185 queue_vms_kbd_input (struct console *con)
2186 {
2187 int input_fd = CONSOLE_TTY_DATA (con)->infd;
2188 int status;
2189 vms_waiting_for_ast = 0;
2190 vms_stop_input = 0;
2191 status = SYS$QIO (0, input_fd, IO$_READVBLK,
2192 &vms_input_iosb, vms_kbd_input_ast, 1,
2193 &vms_input_buffer, 1, 0, vms_terminator_mask, 0, 0);
2194 }
2195
2196 static int vms_input_count;
2197
2198 /* Ast routine that is called when keyboard input comes in
2199 in accord with the SYS$QIO above. */
2200
2201 static void
2202 vms_kbd_input_ast (struct console *con)
2203 {
2204 int c = -1;
2205 int old_errno = errno;
2206 extern EMACS_TIME *input_available_clear_time;
2207
2208 if (vms_waiting_for_ast)
2209 SYS$SETEF (vms_input_ef);
2210 vms_waiting_for_ast = 0;
2211 vms_input_count++;
2212 #ifdef ASTDEBUG
2213 if (vms_input_count == 25)
2214 exit (1);
2215 printf ("Ast # %d,", vms_input_count);
2216 printf (" iosb = %x, %x, %x, %x",
2217 vms_input_iosb.offset, vms_input_iosb.status,
2218 vms_input_iosb.termlen, vms_input_iosb.term);
2219 #endif
2220 if (vms_input_iosb.offset)
2221 {
2222 c = vms_input_buffer;
2223 #ifdef ASTDEBUG
2224 printf (", char = 0%o", c);
2225 #endif
2226 }
2227 #ifdef ASTDEBUG
2228 printf ("\n");
2229 fflush (stdout);
2230 emacs_sleep (1);
2231 #endif
2232 if (! vms_stop_input)
2233 queue_vms_kbd_input (con);
2234 if (c >= 0)
2235 kbd_buffer_store_char (c);
2236
2237 if (input_available_clear_time)
2238 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
2239 errno = old_errno;
2240 }
2241
2242 #if 0 /* Unused */
2243 /* Wait until there is something in kbd_buffer. */
2244
2245 void
2246 vms_wait_for_kbd_input (void)
2247 {
2248 /* This function can GC */
2249 extern int have_process_input, process_exited;
2250
2251 /* If already something, avoid doing system calls. */
2252 if (detect_input_pending (0))
2253 {
2254 return;
2255 }
2256 /* Clear a flag, and tell ast routine above to set it. */
2257 SYS$CLREF (vms_input_ef);
2258 vms_waiting_for_ast = 1;
2259 /* Check for timing error: ast happened while we were doing that. */
2260 if (!detect_input_pending (0))
2261 {
2262 /* No timing error: wait for flag to be set. */
2263 set_waiting_for_input (0);
2264 SYS$WFLOR (vms_input_ef, vms_input_eflist);
2265 clear_waiting_for_input (0);
2266 if (!detect_input_pending (0))
2267 /* Check for subprocess input availability */
2268 {
2269 int dsp = have_process_input || process_exited;
2270
2271 SYS$CLREF (vms_process_ef);
2272 if (have_process_input)
2273 process_command_input ();
2274 if (process_exited)
2275 process_exit ();
2276 if (dsp)
2277 {
2278 MARK_MODELINE_CHANGED;
2279 redisplay ();
2280 }
2281 }
2282 }
2283 vms_waiting_for_ast = 0;
2284 }
2285 #endif
2286
2287 /* Get rid of any pending QIO, when we are about to suspend
2288 or when we want to throw away pending input.
2289 We wait for a positive sign that the AST routine has run
2290 and therefore there is no I/O request queued when we return.
2291 SYS$SETAST is used to avoid a timing error. */
2292
2293 static void
2294 vms_end_kbd_input (struct console *con)
2295 {
2296 int input_fd;
2297
2298 assert (CONSOLE_TTY_P (con));
2299 input_fd = CONSOLE_TTY_DATA (con)->infd;
2300 #ifdef ASTDEBUG
2301 printf ("At end_kbd_input.\n");
2302 fflush (stdout);
2303 emacs_sleep (1);
2304 #endif
2305 if (LIB$AST_IN_PROG ()) /* Don't wait if suspending from kbd_buffer_store_char! */
2306 {
2307 SYS$CANCEL (input_fd);
2308 return;
2309 }
2310
2311 SYS$SETAST (0);
2312 /* Clear a flag, and tell ast routine above to set it. */
2313 SYS$CLREF (vms_input_ef);
2314 vms_waiting_for_ast = 1;
2315 vms_stop_input = 1;
2316 SYS$CANCEL (input_fd);
2317 SYS$SETAST (1);
2318 SYS$WAITFR (vms_input_ef);
2319 vms_waiting_for_ast = 0;
2320 }
2321
2322 #if 0 /* Unused */
2323 /* Wait for either input available or time interval expiry. */
2324
2325 void
2326 vms_input_wait_timeout (int timeval) /* Time to wait, in seconds */
2327 {
2328 int time [2];
2329 static int zero = 0;
2330 static int large = -10000000;
2331
2332 LIB$EMUL (&timeval, &large, &zero, time); /* Convert to VMS format */
2333
2334 /* If already something, avoid doing system calls. */
2335 if (detect_input_pending (0))
2336 {
2337 return;
2338 }
2339 /* Clear a flag, and tell ast routine above to set it. */
2340 SYS$CLREF (vms_input_ef);
2341 vms_waiting_for_ast = 1;
2342 /* Check for timing error: ast happened while we were doing that. */
2343 if (!detect_input_pending (0))
2344 {
2345 /* No timing error: wait for flag to be set. */
2346 SYS$CANTIM (1, 0);
2347 if (SYS$SETIMR (vms_timer_ef, time, 0, 1) & 1) /* Set timer */
2348 SYS$WFLOR (vms_timer_ef, vms_timer_eflist); /* Wait for timer expiry or input */
2349 }
2350 vms_waiting_for_ast = 0;
2351 }
2352 #endif /* 0 */
2353
2354 #endif /* VMS */
2355
2356
2357 /************************************************************************/ 2021 /************************************************************************/
2358 /* limits of text/data segments */ 2022 /* limits of text/data segments */
2359 /************************************************************************/ 2023 /************************************************************************/
2360 2024
2361 /* Note that VMS compiler won't accept defined (CANNOT_DUMP). */ 2025 /* Note that VMS compiler won't accept defined (CANNOT_DUMP). */
2497 /* init_system_name sets up the string for the Lisp function 2161 /* init_system_name sets up the string for the Lisp function
2498 system-name to return. */ 2162 system-name to return. */
2499 2163
2500 extern Lisp_Object Vsystem_name; 2164 extern Lisp_Object Vsystem_name;
2501 2165
2502 #if defined (HAVE_SOCKETS) && !defined (VMS) 2166 #ifdef HAVE_SOCKETS
2503 # include <sys/socket.h> 2167 # include <sys/socket.h>
2504 # include <netdb.h> 2168 # include <netdb.h>
2505 #endif /* HAVE_SOCKETS and not VMS */ 2169 #endif /* HAVE_SOCKETS */
2506 2170
2507 void 2171 void
2508 init_system_name (void) 2172 init_system_name (void)
2509 { 2173 {
2510 #if defined (VMS) 2174 #ifndef HAVE_GETHOSTNAME
2511 char *sp, *end;
2512 if ((sp = egetenv ("SYS$NODE")) == 0)
2513 Vsystem_name = build_string ("vax-vms");
2514 else if ((end = strchr (sp, ':')) == 0)
2515 Vsystem_name = build_string (sp);
2516 else
2517 Vsystem_name = make_string ((Bufbyte *) sp, end - sp);
2518 #elif !defined (HAVE_GETHOSTNAME)
2519 struct utsname uts; 2175 struct utsname uts;
2520 uname (&uts); 2176 uname (&uts);
2521 Vsystem_name = build_string (uts.nodename); 2177 Vsystem_name = build_string (uts.nodename);
2522 #else /* HAVE_GETHOSTNAME */ 2178 #else /* HAVE_GETHOSTNAME */
2523 unsigned int hostname_size = 256; 2179 unsigned int hostname_size = 256;
2582 strcpy (hostname, fqdn); 2238 strcpy (hostname, fqdn);
2583 } 2239 }
2584 } 2240 }
2585 # endif /* HAVE_SOCKETS */ 2241 # endif /* HAVE_SOCKETS */
2586 Vsystem_name = build_string (hostname); 2242 Vsystem_name = build_string (hostname);
2587 #endif /* HAVE_GETHOSTNAME and not VMS */ 2243 #endif /* HAVE_GETHOSTNAME */
2588 { 2244 {
2589 Bufbyte *p; 2245 Bufbyte *p;
2590 Bytecount i; 2246 Bytecount i;
2591 2247
2592 for (i = 0, p = XSTRING_DATA (Vsystem_name); 2248 for (i = 0, p = XSTRING_DATA (Vsystem_name);
2602 2258
2603 /************************************************************************/ 2259 /************************************************************************/
2604 /* Emulation of select() */ 2260 /* Emulation of select() */
2605 /************************************************************************/ 2261 /************************************************************************/
2606 2262
2607 #ifndef VMS
2608 #ifndef HAVE_SELECT 2263 #ifndef HAVE_SELECT
2609 2264
2610 ERROR: XEmacs requires a working select(). 2265 ERROR: XEmacs requires a working select().
2611 2266
2612 #endif /* not HAVE_SELECT */ 2267 #endif /* not HAVE_SELECT */
2613 #endif /* not VMS */
2614 2268
2615 2269
2616 /************************************************************************/ 2270 /************************************************************************/
2617 /* Emulation of signal stuff */ 2271 /* Emulation of signal stuff */
2618 /************************************************************************/ 2272 /************************************************************************/
2706 /* Emulation of strerror() */ 2360 /* Emulation of strerror() */
2707 /************************************************************************/ 2361 /************************************************************************/
2708 2362
2709 #ifndef HAVE_STRERROR 2363 #ifndef HAVE_STRERROR
2710 2364
2711 #if defined (VMS) && defined (LINK_CRTL_SHARE) && defined (SHAREABLE_LIB_BUG)
2712
2713 /* Variables declared noshare and initialized in sharable libraries
2714 cannot be shared. The VMS linker incorrectly forces you to use a private
2715 version which is uninitialized... If not for this "feature", we
2716 could use the C library definition of sys_nerr and sys_errlist. */
2717 CONST char *sys_errlist[] =
2718 {
2719 "error 0",
2720 "not owner",
2721 "no such file or directory",
2722 "no such process",
2723 "interrupted system call",
2724 "I/O error",
2725 "no such device or address",
2726 "argument list too long",
2727 "exec format error",
2728 "bad file number",
2729 "no child process",
2730 "no more processes",
2731 "not enough memory",
2732 "permission denied",
2733 "bad address",
2734 "block device required",
2735 "mount devices busy",
2736 "file exists",
2737 "cross-device link",
2738 "no such device",
2739 "not a directory",
2740 "is a directory",
2741 "invalid argument",
2742 "file table overflow",
2743 "too many open files",
2744 "not a typewriter",
2745 "text file busy",
2746 "file too big",
2747 "no space left on device",
2748 "illegal seek",
2749 "read-only file system",
2750 "too many links",
2751 "broken pipe",
2752 "math argument",
2753 "result too large",
2754 "I/O stream empty",
2755 "vax/vms specific error code nontranslatable error"
2756 };
2757 int sys_nerr = countof (sys_errlist);
2758
2759 #endif /* VMS & LINK_CRTL_SHARE & SHAREABLE_LIB_BUG */
2760
2761
2762 #if !defined(NeXT) && !defined(__alpha) && !defined(MACH) && !defined(LINUX) && !defined(IRIX) && !defined(__NetBSD__) 2365 #if !defined(NeXT) && !defined(__alpha) && !defined(MACH) && !defined(LINUX) && !defined(IRIX) && !defined(__NetBSD__)
2763 /* Linux added here by Raymond L. Toy <toy@alydar.crd.ge.com> for XEmacs. */ 2366 /* Linux added here by Raymond L. Toy <toy@alydar.crd.ge.com> for XEmacs. */
2764 /* Irix added here by gparker@sni-usa.com for XEmacs. */ 2367 /* Irix added here by gparker@sni-usa.com for XEmacs. */
2765 /* NetBSD added here by James R Grinter <jrg@doc.ic.ac.uk> for XEmacs */ 2368 /* NetBSD added here by James R Grinter <jrg@doc.ic.ac.uk> for XEmacs */
2766 extern CONST char *sys_errlist[]; 2369 extern CONST char *sys_errlist[];
2790 /************************************************************************/ 2393 /************************************************************************/
2791 2394
2792 #define PATHNAME_CONVERT_OUT(path) \ 2395 #define PATHNAME_CONVERT_OUT(path) \
2793 GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (path, path) 2396 GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (path, path)
2794 2397
2795 /***** VMS versions are at the bottom of this file *****/
2796 /***** MSDOS versions are in msdos.c *****/ 2398 /***** MSDOS versions are in msdos.c *****/
2797 2399
2798 /***************** low-level calls ****************/ 2400 /***************** low-level calls ****************/
2799 2401
2800 /* 2402 /*
2867 #endif /* ENCAPSULATE_CLOSE */ 2469 #endif /* ENCAPSULATE_CLOSE */
2868 2470
2869 int 2471 int
2870 sys_read_1 (int fildes, void *buf, unsigned int nbyte, int allow_quit) 2472 sys_read_1 (int fildes, void *buf, unsigned int nbyte, int allow_quit)
2871 { 2473 {
2872 #ifdef VMS
2873 return vms_read (fildes, buf, nbyte);
2874 #else
2875 int rtnval; 2474 int rtnval;
2876 2475
2877 /* No harm in looping regardless of the INTERRUPTIBLE_IO setting. */ 2476 /* No harm in looping regardless of the INTERRUPTIBLE_IO setting. */
2878 while ((rtnval = read (fildes, buf, nbyte)) == -1 2477 while ((rtnval = read (fildes, buf, nbyte)) == -1
2879 && (errno == EINTR)) 2478 && (errno == EINTR))
2880 { 2479 {
2881 if (allow_quit) 2480 if (allow_quit)
2882 REALLY_QUIT; 2481 REALLY_QUIT;
2883 } 2482 }
2884 return rtnval; 2483 return rtnval;
2885 #endif
2886 } 2484 }
2887 2485
2888 #ifdef ENCAPSULATE_READ 2486 #ifdef ENCAPSULATE_READ
2889 int 2487 int
2890 sys_read (int fildes, void *buf, unsigned int nbyte) 2488 sys_read (int fildes, void *buf, unsigned int nbyte)
2894 #endif /* ENCAPSULATE_READ */ 2492 #endif /* ENCAPSULATE_READ */
2895 2493
2896 int 2494 int
2897 sys_write_1 (int fildes, CONST void *buf, unsigned int nbyte, int allow_quit) 2495 sys_write_1 (int fildes, CONST void *buf, unsigned int nbyte, int allow_quit)
2898 { 2496 {
2899 #ifdef VMS
2900 return vms_write (fildes, buf, nbyte);
2901 #else
2902 int rtnval; 2497 int rtnval;
2903 int bytes_written = 0; 2498 int bytes_written = 0;
2904 CONST char *b = (CONST char *) buf; 2499 CONST char *b = (CONST char *) buf;
2905 2500
2906 /* No harm in looping regardless of the INTERRUPTIBLE_IO setting. */ 2501 /* No harm in looping regardless of the INTERRUPTIBLE_IO setting. */
2921 b += rtnval; 2516 b += rtnval;
2922 nbyte -= rtnval; 2517 nbyte -= rtnval;
2923 bytes_written += rtnval; 2518 bytes_written += rtnval;
2924 } 2519 }
2925 return (bytes_written); 2520 return (bytes_written);
2926 #endif
2927 } 2521 }
2928 2522
2929 #ifdef ENCAPSULATE_WRITE 2523 #ifdef ENCAPSULATE_WRITE
2930 int 2524 int
2931 sys_write (int fildes, CONST void *buf, unsigned int nbyte) 2525 sys_write (int fildes, CONST void *buf, unsigned int nbyte)
3033 b += size*rtnval; 2627 b += size*rtnval;
3034 nitem -= rtnval; 2628 nitem -= rtnval;
3035 items_written += rtnval; 2629 items_written += rtnval;
3036 } 2630 }
3037 return (items_written); 2631 return (items_written);
3038 #elif defined (VMS)
3039 return vms_fwrite (ptr, size, nitem, stream);
3040 #else 2632 #else
3041 return fwrite (ptr, size, nitem, stream); 2633 return fwrite (ptr, size, nitem, stream);
3042 #endif 2634 #endif
3043 } 2635 }
3044 #endif /* ENCAPSULATE_FWRITE */ 2636 #endif /* ENCAPSULATE_FWRITE */
3170 #ifdef ENCAPSULATE_ACCESS 2762 #ifdef ENCAPSULATE_ACCESS
3171 int 2763 int
3172 sys_access (CONST char *path, int mode) 2764 sys_access (CONST char *path, int mode)
3173 { 2765 {
3174 PATHNAME_CONVERT_OUT (path); 2766 PATHNAME_CONVERT_OUT (path);
3175 #ifdef VMS
3176 return vms_access (path, mode);
3177 #else
3178 return access (path, mode); 2767 return access (path, mode);
3179 #endif
3180 } 2768 }
3181 #endif /* ENCAPSULATE_ACCESS */ 2769 #endif /* ENCAPSULATE_ACCESS */
3182 2770
3183 2771
3184 #ifdef HAVE_EACCESS 2772 #ifdef HAVE_EACCESS
3884 sys_close (dirp->dd_fd); 3472 sys_close (dirp->dd_fd);
3885 xfree (dirp); 3473 xfree (dirp);
3886 } 3474 }
3887 3475
3888 3476
3889 #ifndef VMS
3890 #define DIRSIZ 14 3477 #define DIRSIZ 14
3891 struct olddir 3478 struct olddir
3892 { 3479 {
3893 ino_t od_ino; /* inode */ 3480 ino_t od_ino; /* inode */
3894 char od_name[DIRSIZ]; /* filename */ 3481 char od_name[DIRSIZ]; /* filename */
3895 }; 3482 };
3896 #endif /* not VMS */
3897 3483
3898 static struct direct dir_static; /* simulated directory contents */ 3484 static struct direct dir_static; /* simulated directory contents */
3899 3485
3900 /* ARGUSED */ 3486 /* ARGUSED */
3901 struct direct * 3487 struct direct *
3902 readdir (DIR *dirp) /* stream from opendir */ 3488 readdir (DIR *dirp) /* stream from opendir */
3903 { 3489 {
3904 #ifndef VMS
3905 struct olddir *dp; /* -> directory data */ 3490 struct olddir *dp; /* -> directory data */
3906 #else /* VMS */
3907 struct dir$_name *dp; /* -> directory data */
3908 struct dir$_version *dv; /* -> version data */
3909 #endif /* VMS */
3910 3491
3911 for (; ;) 3492 for (; ;)
3912 { 3493 {
3913 if (dirp->dd_loc >= dirp->dd_size) 3494 if (dirp->dd_loc >= dirp->dd_size)
3914 dirp->dd_loc = dirp->dd_size = 0; 3495 dirp->dd_loc = dirp->dd_size = 0;
3915 3496
3916 if (dirp->dd_size == 0 /* refill buffer */ 3497 if (dirp->dd_size == 0 /* refill buffer */
3917 && (dirp->dd_size = sys_read (dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ)) <= 0) 3498 && (dirp->dd_size = sys_read (dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ)) <= 0)
3918 return 0; 3499 return 0;
3919 3500
3920 #ifndef VMS
3921 dp = (struct olddir *) &dirp->dd_buf[dirp->dd_loc]; 3501 dp = (struct olddir *) &dirp->dd_buf[dirp->dd_loc];
3922 dirp->dd_loc += sizeof (struct olddir); 3502 dirp->dd_loc += sizeof (struct olddir);
3923 3503
3924 if (dp->od_ino != 0) /* not deleted entry */ 3504 if (dp->od_ino != 0) /* not deleted entry */
3925 { 3505 {
3930 dir_static.d_reclen = sizeof (struct direct) 3510 dir_static.d_reclen = sizeof (struct direct)
3931 - MAXNAMLEN + 3 3511 - MAXNAMLEN + 3
3932 + dir_static.d_namlen - dir_static.d_namlen % 4; 3512 + dir_static.d_namlen - dir_static.d_namlen % 4;
3933 return &dir_static; /* -> simulated structure */ 3513 return &dir_static; /* -> simulated structure */
3934 } 3514 }
3935 #else /* VMS */ 3515 }
3936 dp = (struct dir$_name *) dirp->dd_buf; 3516 }
3937 if (dirp->dd_loc == 0) 3517
3938 dirp->dd_loc = (dp->dir$b_namecount&1) ? dp->dir$b_namecount + 1
3939 : dp->dir$b_namecount;
3940 dv = (struct dir$_version *)&dp->dir$t_name[dirp->dd_loc];
3941 dir_static.d_ino = dv->dir$w_fid_num;
3942 dir_static.d_namlen = dp->dir$b_namecount;
3943 dir_static.d_reclen = sizeof (struct direct)
3944 - MAXNAMLEN + 3
3945 + dir_static.d_namlen - dir_static.d_namlen % 4;
3946 strncpy (dir_static.d_name, dp->dir$t_name, dp->dir$b_namecount);
3947 dir_static.d_name[dir_static.d_namlen] = '\0';
3948 dirp->dd_loc = dirp->dd_size; /* only one record at a time */
3949 return &dir_static;
3950 #endif /* VMS */
3951 }
3952 }
3953
3954 #ifdef VMS
3955 /* readdirver is just like readdir except it returns all versions of a file
3956 as separate entries. */
3957
3958 /* ARGUSED */
3959 struct direct *
3960 readdirver (DIR *dirp) /* stream from opendir */
3961 {
3962 struct dir$_name *dp; /* -> directory data */
3963 struct dir$_version *dv; /* -> version data */
3964
3965 if (dirp->dd_loc >= dirp->dd_size - sizeof (struct dir$_name))
3966 dirp->dd_loc = dirp->dd_size = 0;
3967
3968 if (dirp->dd_size == 0 /* refill buffer */
3969 && (dirp->dd_size = sys_read (dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ)) <= 0)
3970 return 0;
3971
3972 dp = (struct dir$_name *) dirp->dd_buf;
3973 if (dirp->dd_loc == 0)
3974 dirp->dd_loc = (dp->dir$b_namecount & 1) ? dp->dir$b_namecount + 1
3975 : dp->dir$b_namecount;
3976 dv = (struct dir$_version *) &dp->dir$t_name[dirp->dd_loc];
3977 strncpy (dir_static.d_name, dp->dir$t_name, dp->dir$b_namecount);
3978 sprintf (&dir_static.d_name[dp->dir$b_namecount], ";%d", dv->dir$w_version);
3979 dir_static.d_namlen = strlen (dir_static.d_name);
3980 dir_static.d_ino = dv->dir$w_fid_num;
3981 dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3
3982 + dir_static.d_namlen - dir_static.d_namlen % 4;
3983 dirp->dd_loc = ((char *) (++dv) - dp->dir$t_name);
3984 return &dir_static;
3985 }
3986
3987 #endif /* VMS */
3988 3518
3989 #endif /* NONSYSTEM_DIR_LIBRARY */ 3519 #endif /* NONSYSTEM_DIR_LIBRARY */
3990 3520
3991 3521
3992 /* mkdir and rmdir functions, for systems which don't have them. */ 3522 /* mkdir and rmdir functions, for systems which don't have them. */
4147 } 3677 }
4148 3678
4149 #endif /* USE_DL_STUBS */ 3679 #endif /* USE_DL_STUBS */
4150 3680
4151 3681
4152 /************************************************************************/
4153 /* VMS emulation of system calls */
4154 /************************************************************************/
4155
4156 #ifdef VMS
4157 #include "vms-pwd.h"
4158 #include <acldef.h>
4159 #include <chpdef.h>
4160 #include <jpidef.h>
4161
4162 /* Return as a string the VMS error string pertaining to STATUS.
4163 Reuses the same static buffer each time it is called. */
4164
4165 char *
4166 vmserrstr (int status) /* VMS status code */
4167 {
4168 int bufadr[2];
4169 short len;
4170 static char buf[257];
4171
4172 bufadr[0] = sizeof buf - 1;
4173 bufadr[1] = (int) buf;
4174 if (! (SYS$GETMSG (status, &len, bufadr, 0x1, 0) & 1))
4175 return "untranslatable VMS error status";
4176 buf[len] = '\0';
4177 return buf;
4178 }
4179
4180 #ifdef access
4181 #undef access
4182
4183 /* The following is necessary because 'access' emulation by VMS C (2.0) does
4184 * not work correctly. (It also doesn't work well in version 2.3.)
4185 */
4186
4187 #ifdef VMS4_4
4188
4189 #define DESCRIPTOR(name,string) struct dsc$descriptor_s name = \
4190 { strlen (string), DSC$K_DTYPE_T, DSC$K_CLASS_S, string }
4191
4192 typedef union {
4193 struct {
4194 unsigned short s_buflen;
4195 unsigned short s_code;
4196 char *s_bufadr;
4197 unsigned short *s_retlenadr;
4198 } s;
4199 int end;
4200 } item;
4201 #define buflen s.s_buflen
4202 #define code s.s_code
4203 #define bufadr s.s_bufadr
4204 #define retlenadr s.s_retlenadr
4205
4206 #define R_OK 4 /* test for read permission */
4207 #define W_OK 2 /* test for write permission */
4208 #define X_OK 1 /* test for execute (search) permission */
4209 #define F_OK 0 /* test for presence of file */
4210
4211 int
4212 vms_access (CONST char *path, int mode)
4213 {
4214 static char *user = NULL;
4215 char dir_fn[512];
4216
4217 /* translate possible directory spec into .DIR file name, so brain-dead
4218 * access can treat the directory like a file. */
4219 if (directory_file_name (path, dir_fn))
4220 path = dir_fn;
4221
4222 if (mode == F_OK)
4223 return access (path, mode);
4224 if (user == NULL && (user = (char *) getenv ("USER")) == NULL)
4225 return -1;
4226 {
4227 int stat;
4228 int flags;
4229 int acces;
4230 unsigned short int dummy;
4231 item itemlst[3];
4232 static int constant = ACL$C_FILE;
4233 DESCRIPTOR (path_desc, path);
4234 DESCRIPTOR (user_desc, user);
4235
4236 flags = 0;
4237 acces = 0;
4238 if ((mode & X_OK) && ((stat = access (path, mode)) < 0 || mode == X_OK))
4239 return stat;
4240 if (mode & R_OK)
4241 acces |= CHP$M_READ;
4242 if (mode & W_OK)
4243 acces |= CHP$M_WRITE;
4244 itemlst[0].buflen = sizeof (int);
4245 itemlst[0].code = CHP$_FLAGS;
4246 itemlst[0].bufadr = (char *) &flags;
4247 itemlst[0].retlenadr = &dummy;
4248 itemlst[1].buflen = sizeof (int);
4249 itemlst[1].code = CHP$_ACCESS;
4250 itemlst[1].bufadr = (char *) &acces;
4251 itemlst[1].retlenadr = &dummy;
4252 itemlst[2].end = CHP$_END;
4253 stat = SYS$CHECK_ACCESS (&constant, &path_desc, &user_desc, itemlst);
4254 return stat == SS$_NORMAL ? 0 : -1;
4255 }
4256 }
4257
4258 #else /* not VMS4_4 */
4259
4260 #include <prvdef.h>
4261 #define ACE$M_WRITE 2
4262 #define ACE$C_KEYID 1
4263
4264 static unsigned short vms_memid, vms_grpid;
4265 static unsigned int vms_uic;
4266
4267 /* Called from init_sys_modes, so it happens not very often
4268 but at least each time Emacs is loaded. */
4269 sys_access_reinit (void)
4270 {
4271 vms_uic = 0;
4272 }
4273
4274 int
4275 vms_access (CONST char *filename, int type)
4276 {
4277 struct FAB fab;
4278 struct XABPRO xab;
4279 int status, size, i, typecode, acl_controlled;
4280 unsigned int *aclptr, *aclend, aclbuf[60];
4281 union prvdef prvmask;
4282
4283 /* Get UIC and GRP values for protection checking. */
4284 if (vms_uic == 0)
4285 {
4286 status = LIB$GETJPI (&JPI$_UIC, 0, 0, &vms_uic, 0, 0);
4287 if (! (status & 1))
4288 return -1;
4289 vms_memid = vms_uic & 0xFFFF;
4290 vms_grpid = vms_uic >> 16;
4291 }
4292
4293 if (type != 2) /* not checking write access */
4294 return access (filename, type);
4295
4296 /* Check write protection. */
4297
4298 #define CHECKPRIV(bit) (prvmask.bit)
4299 #define WRITEABLE(field) (! ((xab.xab$w_pro >> field) & XAB$M_NOWRITE))
4300
4301 /* Find privilege bits */
4302 status = SYS$SETPRV (0, 0, 0, prvmask);
4303 if (! (status & 1))
4304 error ("Unable to find privileges: %s", vmserrstr (status));
4305 if (CHECKPRIV (PRV$V_BYPASS))
4306 return 0; /* BYPASS enabled */
4307 fab = cc$rms_fab;
4308 fab.fab$b_fac = FAB$M_GET;
4309 fab.fab$l_fna = filename;
4310 fab.fab$b_fns = strlen (filename);
4311 fab.fab$l_xab = &xab;
4312 xab = cc$rms_xabpro;
4313 xab.xab$l_aclbuf = aclbuf;
4314 xab.xab$w_aclsiz = sizeof (aclbuf);
4315 status = SYS$OPEN (&fab, 0, 0);
4316 if (! (status & 1))
4317 return -1;
4318 SYS$CLOSE (&fab, 0, 0);
4319 /* Check system access */
4320 if (CHECKPRIV (PRV$V_SYSPRV) && WRITEABLE (XAB$V_SYS))
4321 return 0;
4322 /* Check ACL entries, if any */
4323 acl_controlled = 0;
4324 if (xab.xab$w_acllen > 0)
4325 {
4326 aclptr = aclbuf;
4327 aclend = &aclbuf[xab.xab$w_acllen / 4];
4328 while (*aclptr && aclptr < aclend)
4329 {
4330 size = (*aclptr & 0xff) / 4;
4331 typecode = (*aclptr >> 8) & 0xff;
4332 if (typecode == ACE$C_KEYID)
4333 for (i = size - 1; i > 1; i--)
4334 if (aclptr[i] == vms_uic)
4335 {
4336 acl_controlled = 1;
4337 if (aclptr[1] & ACE$M_WRITE)
4338 return 0; /* Write access through ACL */
4339 }
4340 aclptr = &aclptr[size];
4341 }
4342 if (acl_controlled) /* ACL specified, prohibits write access */
4343 return -1;
4344 }
4345 /* No ACL entries specified, check normal protection */
4346 if (WRITEABLE (XAB$V_WLD)) /* World writeable */
4347 return 0;
4348 if (WRITEABLE (XAB$V_GRP) &&
4349 (unsigned short) (xab.xab$l_uic >> 16) == vms_grpid)
4350 return 0; /* Group writeable */
4351 if (WRITEABLE (XAB$V_OWN) &&
4352 (xab.xab$l_uic & 0xFFFF) == vms_memid)
4353 return 0; /* Owner writeable */
4354
4355 return -1; /* Not writeable */
4356 }
4357 #endif /* not VMS4_4 */
4358 #endif /* access */
4359
4360 static char vtbuf[NAM$C_MAXRSS+1];
4361
4362 /* translate a vms file spec to a unix path */
4363 char *
4364 sys_translate_vms (char *vfile)
4365 {
4366 char * p;
4367 char * targ;
4368
4369 if (!vfile)
4370 return 0;
4371
4372 targ = vtbuf;
4373
4374 /* leading device or logical name is a root directory */
4375 if (p = strchr (vfile, ':'))
4376 {
4377 *targ++ = '/';
4378 while (vfile < p)
4379 *targ++ = *vfile++;
4380 vfile++;
4381 *targ++ = '/';
4382 }
4383 p = vfile;
4384 if (*p == '[' || *p == '<')
4385 {
4386 while (*++vfile != *p + 2)
4387 switch (*vfile)
4388 {
4389 case '.':
4390 if (vfile[-1] == *p)
4391 *targ++ = '.';
4392 *targ++ = '/';
4393 break;
4394
4395 case '-':
4396 *targ++ = '.';
4397 *targ++ = '.';
4398 break;
4399
4400 default:
4401 *targ++ = *vfile;
4402 break;
4403 }
4404 vfile++;
4405 *targ++ = '/';
4406 }
4407 while (*vfile)
4408 *targ++ = *vfile++;
4409
4410 return vtbuf;
4411 }
4412
4413 static char utbuf[NAM$C_MAXRSS+1];
4414
4415 /* translate a unix path to a VMS file spec */
4416 char *
4417 sys_translate_unix (char *ufile)
4418 {
4419 int slash_seen = 0;
4420 char *p;
4421 char * targ;
4422
4423 if (!ufile)
4424 return 0;
4425
4426 targ = utbuf;
4427
4428 if (*ufile == '/')
4429 {
4430 ufile++;
4431 }
4432
4433 while (*ufile)
4434 {
4435 switch (*ufile)
4436 {
4437 case '/':
4438 if (slash_seen)
4439 if (strchr (&ufile[1], '/'))
4440 *targ++ = '.';
4441 else
4442 *targ++ = ']';
4443 else
4444 {
4445 *targ++ = ':';
4446 if (strchr (&ufile[1], '/'))
4447 *targ++ = '[';
4448 slash_seen = 1;
4449 }
4450 break;
4451
4452 case '.':
4453 if (strncmp (ufile, "./", 2) == 0)
4454 {
4455 if (!slash_seen)
4456 {
4457 *targ++ = '[';
4458 slash_seen = 1;
4459 }
4460 ufile++; /* skip the dot */
4461 if (strchr (&ufile[1], '/'))
4462 *targ++ = '.';
4463 else
4464 *targ++ = ']';
4465 }
4466 else if (strncmp (ufile, "../", 3) == 0)
4467 {
4468 if (!slash_seen)
4469 {
4470 *targ++ = '[';
4471 slash_seen = 1;
4472 }
4473 *targ++ = '-';
4474 ufile += 2; /* skip the dots */
4475 if (strchr (&ufile[1], '/'))
4476 *targ++ = '.';
4477 else
4478 *targ++ = ']';
4479 }
4480 else
4481 *targ++ = *ufile;
4482 break;
4483
4484 default:
4485 *targ++ = *ufile;
4486 break;
4487 }
4488 ufile++;
4489 }
4490 *targ = '\0';
4491
4492 return utbuf;
4493 }
4494
4495 char *
4496 getwd (char *pathname)
4497 {
4498 char *ptr;
4499 strcpy (pathname, egetenv ("PATH"));
4500
4501 ptr = pathname;
4502 while (*ptr)
4503 {
4504 /* #### This is evil. Smashes (shared) result of egetenv */
4505 *ptr = toupper (* (unsigned char *) ptr);
4506 ptr++;
4507 }
4508 return pathname;
4509 }
4510
4511 int
4512 getppid (void)
4513 {
4514 long item_code = JPI$_OWNER;
4515 unsigned long parent_id;
4516 int status;
4517
4518 if (((status = LIB$GETJPI (&item_code, 0, 0, &parent_id)) & 1) == 0)
4519 {
4520 errno = EVMSERR;
4521 vaxc$errno = status;
4522 return -1;
4523 }
4524 return parent_id;
4525 }
4526
4527 #undef getuid
4528 unsigned int
4529 sys_getuid (void)
4530 {
4531 return (getgid () << 16) | getuid ();
4532 }
4533
4534 int
4535 vms_read (int fildes, CONST void *buf, unsigned int nbyte)
4536 {
4537 return read (fildes, buf, (nbyte < MAXIOSIZE ? nbyte : MAXIOSIZE));
4538 }
4539
4540 #if 0
4541 int
4542 vms_write (int fildes, CONST void *buf, unsigned int nbyte)
4543 {
4544 int nwrote, rtnval = 0;
4545
4546 while (nbyte > MAXIOSIZE && (nwrote = write (fildes, buf, MAXIOSIZE)) > 0)
4547 {
4548 nbyte -= nwrote;
4549 buf += nwrote;
4550 rtnval += nwrote;
4551 }
4552 if (nwrote < 0)
4553 return rtnval ? rtnval : -1;
4554 if ((nwrote = write (fildes, buf, nbyte)) < 0)
4555 return rtnval ? rtnval : -1;
4556 return (rtnval + nwrote);
4557 }
4558 #endif /* 0 */
4559
4560 /*
4561 * VAX/VMS VAX C RTL really loses. It insists that records
4562 * end with a newline (carriage return) character, and if they
4563 * don't it adds one (nice of it isn't it!)
4564 *
4565 * Thus we do this stupidity below.
4566 */
4567
4568 int
4569 vms_write (int fildes, CONST void *buf, unsigned int nbytes)
4570 {
4571 char *p;
4572 char *e;
4573 int sum = 0;
4574 struct stat st;
4575
4576 fstat (fildes, &st);
4577 p = buf;
4578 while (nbytes > 0)
4579 {
4580 int len, retval;
4581
4582 /* Handle fixed-length files with carriage control. */
4583 if (st.st_fab_rfm == FAB$C_FIX
4584 && ((st.st_fab_rat & (FAB$M_FTN | FAB$M_CR)) != 0))
4585 {
4586 len = st.st_fab_mrs;
4587 retval = write (fildes, p, min (len, nbytes));
4588 if (retval != len)
4589 return -1;
4590 retval++; /* This skips the implied carriage control */
4591 }
4592 else
4593 {
4594 e = p + min (MAXIOSIZE, nbytes) - 1;
4595 while (*e != '\n' && e > p) e--;
4596 if (p == e) /* Ok.. so here we add a newline... sigh. */
4597 e = p + min (MAXIOSIZE, nbytes) - 1;
4598 len = e + 1 - p;
4599 retval = write (fildes, p, len);
4600 if (retval != len)
4601 return -1;
4602 }
4603 p += retval;
4604 sum += retval;
4605 nbytes -= retval;
4606 }
4607 return sum;
4608 }
4609
4610 /* Create file NEW copying its attributes from file OLD. If
4611 OLD is 0 or does not exist, create based on the value of
4612 vms_stmlf_recfm. */
4613
4614 /* Protection value the file should ultimately have.
4615 Set by create_copy_attrs, and use by rename_sansversions. */
4616 static unsigned short int vms_fab_final_pro;
4617
4618 int
4619 creat_copy_attrs (char *old, char *new)
4620 {
4621 struct FAB fab = cc$rms_fab;
4622 struct XABPRO xabpro;
4623 char aclbuf[256]; /* Choice of size is arbitrary. See below. */
4624 extern int vms_stmlf_recfm;
4625
4626 if (old)
4627 {
4628 fab.fab$b_fac = FAB$M_GET;
4629 fab.fab$l_fna = old;
4630 fab.fab$b_fns = strlen (old);
4631 fab.fab$l_xab = (char *) &xabpro;
4632 xabpro = cc$rms_xabpro;
4633 xabpro.xab$l_aclbuf = aclbuf;
4634 xabpro.xab$w_aclsiz = sizeof aclbuf;
4635 /* Call $OPEN to fill in the fab & xabpro fields. */
4636 if (SYS$OPEN (&fab, 0, 0) & 1)
4637 {
4638 SYS$CLOSE (&fab, 0, 0);
4639 fab.fab$l_alq = 0; /* zero the allocation quantity */
4640 if (xabpro.xab$w_acllen > 0)
4641 {
4642 if (xabpro.xab$w_acllen > sizeof aclbuf)
4643 /* If the acl buffer was too short, redo open with longer one.
4644 Wouldn't need to do this if there were some system imposed
4645 limit on the size of an ACL, but I can't find any such. */
4646 {
4647 xabpro.xab$l_aclbuf = (char *) alloca (xabpro.xab$w_acllen);
4648 xabpro.xab$w_aclsiz = xabpro.xab$w_acllen;
4649 if (SYS$OPEN (&fab, 0, 0) & 1)
4650 SYS$CLOSE (&fab, 0, 0);
4651 else
4652 old = 0;
4653 }
4654 }
4655 else
4656 xabpro.xab$l_aclbuf = 0;
4657 }
4658 else
4659 old = 0;
4660 }
4661 fab.fab$l_fna = new;
4662 fab.fab$b_fns = strlen (new);
4663 if (!old)
4664 {
4665 fab.fab$l_xab = 0;
4666 fab.fab$b_rfm = vms_stmlf_recfm ? FAB$C_STMLF : FAB$C_VAR;
4667 fab.fab$b_rat = FAB$M_CR;
4668 }
4669
4670 /* Set the file protections such that we will be able to manipulate
4671 this file. Once we are done writing and renaming it, we will set
4672 the protections back. */
4673 if (old)
4674 vms_fab_final_pro = xabpro.xab$w_pro;
4675 else
4676 SYS$SETDFPROT (0, &vms_fab_final_pro);
4677 xabpro.xab$w_pro &= 0xff0f; /* set O:rewd for now. This is set back later. */
4678
4679 /* Create the new file with either default attrs or attrs copied
4680 from old file. */
4681 if (!(SYS$CREATE (&fab, 0, 0) & 1))
4682 return -1;
4683 SYS$CLOSE (&fab, 0, 0);
4684 /* As this is a "replacement" for creat, return a file descriptor
4685 opened for writing. */
4686 return open (new, O_WRONLY);
4687 }
4688
4689 int
4690 vms_creat (CONST char *path, int mode, ...)
4691 {
4692 int rfd; /* related file descriptor */
4693 int fd; /* Our new file descriptor */
4694 int count;
4695 struct stat st_buf;
4696 char rfm[12];
4697 char rat[15];
4698 char mrs[13];
4699 char fsz[13];
4700 extern int vms_stmlf_recfm;
4701
4702 /* #### there was some weird machine-dependent code to determine how many
4703 arguments were passed to this function. This certainly won't work
4704 under ANSI C. */
4705 if (count > 2)
4706 rfd = fix this;
4707 if (count > 2)
4708 {
4709 /* Use information from the related file descriptor to set record
4710 format of the newly created file. */
4711 fstat (rfd, &st_buf);
4712 switch (st_buf.st_fab_rfm)
4713 {
4714 case FAB$C_FIX:
4715 strcpy (rfm, "rfm = fix");
4716 sprintf (mrs, "mrs = %d", st_buf.st_fab_mrs);
4717 strcpy (rat, "rat = ");
4718 if (st_buf.st_fab_rat & FAB$M_CR)
4719 strcat (rat, "cr");
4720 else if (st_buf.st_fab_rat & FAB$M_FTN)
4721 strcat (rat, "ftn");
4722 else if (st_buf.st_fab_rat & FAB$M_PRN)
4723 strcat (rat, "prn");
4724 if (st_buf.st_fab_rat & FAB$M_BLK)
4725 if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN))
4726 strcat (rat, ", blk");
4727 else
4728 strcat (rat, "blk");
4729 return creat (name, 0, rfm, rat, mrs);
4730
4731 case FAB$C_VFC:
4732 strcpy (rfm, "rfm = vfc");
4733 sprintf (fsz, "fsz = %d", st_buf.st_fab_fsz);
4734 strcpy (rat, "rat = ");
4735 if (st_buf.st_fab_rat & FAB$M_CR)
4736 strcat (rat, "cr");
4737 else if (st_buf.st_fab_rat & FAB$M_FTN)
4738 strcat (rat, "ftn");
4739 else if (st_buf.st_fab_rat & FAB$M_PRN)
4740 strcat (rat, "prn");
4741 if (st_buf.st_fab_rat & FAB$M_BLK)
4742 if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN))
4743 strcat (rat, ", blk");
4744 else
4745 strcat (rat, "blk");
4746 return creat (name, 0, rfm, rat, fsz);
4747
4748 case FAB$C_STM:
4749 strcpy (rfm, "rfm = stm");
4750 break;
4751
4752 case FAB$C_STMCR:
4753 strcpy (rfm, "rfm = stmcr");
4754 break;
4755
4756 case FAB$C_STMLF:
4757 strcpy (rfm, "rfm = stmlf");
4758 break;
4759
4760 case FAB$C_UDF:
4761 strcpy (rfm, "rfm = udf");
4762 break;
4763
4764 case FAB$C_VAR:
4765 strcpy (rfm, "rfm = var");
4766 break;
4767 }
4768 strcpy (rat, "rat = ");
4769 if (st_buf.st_fab_rat & FAB$M_CR)
4770 strcat (rat, "cr");
4771 else if (st_buf.st_fab_rat & FAB$M_FTN)
4772 strcat (rat, "ftn");
4773 else if (st_buf.st_fab_rat & FAB$M_PRN)
4774 strcat (rat, "prn");
4775 if (st_buf.st_fab_rat & FAB$M_BLK)
4776 if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN))
4777 strcat (rat, ", blk");
4778 else
4779 strcat (rat, "blk");
4780 }
4781 else
4782 {
4783 strcpy (rfm, vms_stmlf_recfm ? "rfm = stmlf" : "rfm=var");
4784 strcpy (rat, "rat=cr");
4785 }
4786 /* Until the VAX C RTL fixes the many bugs with modes, always use
4787 mode 0 to get the user's default protection. */
4788 fd = creat (name, 0, rfm, rat);
4789 if (fd < 0 && errno == EEXIST)
4790 {
4791 if (unlink (name) < 0)
4792 report_file_error ("delete", build_string (name));
4793 fd = creat (name, 0, rfm, rat);
4794 }
4795 return fd;
4796 }
4797
4798 /* fwrite to stdout is S L O W. Speed it up by using fputc...*/
4799 int
4800 vms_fwrite (CONST void *ptr, int size, int num, FILE *fp)
4801 {
4802 int tot = num * size;
4803
4804 while (tot--)
4805 fputc (* (CONST char *) ptr++, fp);
4806 return (num);
4807 }
4808
4809 /*
4810 * The VMS C library routine creat actually creates a new version of an
4811 * existing file rather than truncating the old version. There are times
4812 * when this is not the desired behavior, for instance, when writing an
4813 * auto save file (you only want one version), or when you don't have
4814 * write permission in the directory containing the file (but the file
4815 * itself is writable). Hence this routine, which is equivalent to
4816 * "close (creat (fn, 0));" on Unix if fn already exists.
4817 */
4818 int
4819 vms_truncate (char *fn)
4820 {
4821 struct FAB xfab = cc$rms_fab;
4822 struct RAB xrab = cc$rms_rab;
4823 int status;
4824
4825 xfab.fab$l_fop = FAB$M_TEF; /* free allocated but unused blocks on close */
4826 xfab.fab$b_fac = FAB$M_TRN | FAB$M_GET; /* allow truncate and get access */
4827 xfab.fab$b_shr = FAB$M_NIL; /* allow no sharing - file must be locked */
4828 xfab.fab$l_fna = fn;
4829 xfab.fab$b_fns = strlen (fn);
4830 xfab.fab$l_dna = ";0"; /* default to latest version of the file */
4831 xfab.fab$b_dns = 2;
4832 xrab.rab$l_fab = &xfab;
4833
4834 /* This gibberish opens the file, positions to the first record, and
4835 deletes all records from there until the end of file. */
4836 if ((SYS$OPEN (&xfab) & 01) == 01)
4837 {
4838 if ((SYS$CONNECT (&xrab) & 01) == 01 &&
4839 (SYS$FIND (&xrab) & 01) == 01 &&
4840 (SYS$TRUNCATE (&xrab) & 01) == 01)
4841 status = 0;
4842 else
4843 status = -1;
4844 }
4845 else
4846 status = -1;
4847 SYS$CLOSE (&xfab);
4848 return status;
4849 }
4850
4851 /* Define this symbol to actually read SYSUAF.DAT. This requires either
4852 SYSPRV or a readable SYSUAF.DAT. */
4853
4854 #ifdef READ_SYSUAF
4855 /*
4856 * getuaf.c
4857 *
4858 * Routine to read the VMS User Authorization File and return
4859 * a specific user's record.
4860 */
4861
4862 static struct UAF vms_retuaf;
4863
4864 static struct UAF *
4865 get_uaf_name (char *uname)
4866 {
4867 status;
4868 struct FAB uaf_fab;
4869 struct RAB uaf_rab;
4870
4871 uaf_fab = cc$rms_fab;
4872 uaf_rab = cc$rms_rab;
4873 /* initialize fab fields */
4874 uaf_fab.fab$l_fna = "SYS$SYSTEM:SYSUAF.DAT";
4875 uaf_fab.fab$b_fns = 21;
4876 uaf_fab.fab$b_fac = FAB$M_GET;
4877 uaf_fab.fab$b_org = FAB$C_IDX;
4878 uaf_fab.fab$b_shr = FAB$M_GET|FAB$M_PUT|FAB$M_UPD|FAB$M_DEL;
4879 /* initialize rab fields */
4880 uaf_rab.rab$l_fab = &uaf_fab;
4881 /* open the User Authorization File */
4882 status = SYS$OPEN (&uaf_fab);
4883 if (!(status&1))
4884 {
4885 errno = EVMSERR;
4886 vaxc$errno = status;
4887 return 0;
4888 }
4889 status = SYS$CONNECT (&uaf_rab);
4890 if (!(status&1))
4891 {
4892 errno = EVMSERR;
4893 vaxc$errno = status;
4894 return 0;
4895 }
4896 /* read the requested record - index is in uname */
4897 uaf_rab.rab$l_kbf = uname;
4898 uaf_rab.rab$b_ksz = strlen (uname);
4899 uaf_rab.rab$b_rac = RAB$C_KEY;
4900 uaf_rab.rab$l_ubf = (char *)&vms_retuaf;
4901 uaf_rab.rab$w_usz = sizeof vms_retuaf;
4902 status = SYS$GET (&uaf_rab);
4903 if (!(status&1))
4904 {
4905 errno = EVMSERR;
4906 vaxc$errno = status;
4907 return 0;
4908 }
4909 /* close the User Authorization File */
4910 status = SYS$DISCONNECT (&uaf_rab);
4911 if (!(status&1))
4912 {
4913 errno = EVMSERR;
4914 vaxc$errno = status;
4915 return 0;
4916 }
4917 status = SYS$CLOSE (&uaf_fab);
4918 if (!(status&1))
4919 {
4920 errno = EVMSERR;
4921 vaxc$errno = status;
4922 return 0;
4923 }
4924 return &vms_retuaf;
4925 }
4926
4927 static struct UAF *
4928 get_uaf_uic (unsigned long uic)
4929 {
4930 status;
4931 struct FAB uaf_fab;
4932 struct RAB uaf_rab;
4933
4934 uaf_fab = cc$rms_fab;
4935 uaf_rab = cc$rms_rab;
4936 /* initialize fab fields */
4937 uaf_fab.fab$l_fna = "SYS$SYSTEM:SYSUAF.DAT";
4938 uaf_fab.fab$b_fns = 21;
4939 uaf_fab.fab$b_fac = FAB$M_GET;
4940 uaf_fab.fab$b_org = FAB$C_IDX;
4941 uaf_fab.fab$b_shr = FAB$M_GET|FAB$M_PUT|FAB$M_UPD|FAB$M_DEL;
4942 /* initialize rab fields */
4943 uaf_rab.rab$l_fab = &uaf_fab;
4944 /* open the User Authorization File */
4945 status = SYS$OPEN (&uaf_fab);
4946 if (!(status&1))
4947 {
4948 errno = EVMSERR;
4949 vaxc$errno = status;
4950 return 0;
4951 }
4952 status = SYS$CONNECT (&uaf_rab);
4953 if (!(status&1))
4954 {
4955 errno = EVMSERR;
4956 vaxc$errno = status;
4957 return 0;
4958 }
4959 /* read the requested record - index is in uic */
4960 uaf_rab.rab$b_krf = 1; /* 1st alternate key */
4961 uaf_rab.rab$l_kbf = (char *) &uic;
4962 uaf_rab.rab$b_ksz = sizeof uic;
4963 uaf_rab.rab$b_rac = RAB$C_KEY;
4964 uaf_rab.rab$l_ubf = (char *)&vms_retuaf;
4965 uaf_rab.rab$w_usz = sizeof vms_retuaf;
4966 status = SYS$GET (&uaf_rab);
4967 if (!(status&1))
4968 {
4969 errno = EVMSERR;
4970 vaxc$errno = status;
4971 return 0;
4972 }
4973 /* close the User Authorization File */
4974 status = SYS$DISCONNECT (&uaf_rab);
4975 if (!(status&1))
4976 {
4977 errno = EVMSERR;
4978 vaxc$errno = status;
4979 return 0;
4980 }
4981 status = SYS$CLOSE (&uaf_fab);
4982 if (!(status&1))
4983 {
4984 errno = EVMSERR;
4985 vaxc$errno = status;
4986 return 0;
4987 }
4988 return &vms_retuaf;
4989 }
4990
4991 static struct passwd vms_retpw;
4992
4993 static struct passwd *
4994 cnv_uaf_pw (struct UAF *up)
4995 {
4996 char * ptr;
4997
4998 /* copy these out first because if the username is 32 chars, the next
4999 section will overwrite the first byte of the UIC */
5000 vms_retpw.pw_uid = up->uaf$w_mem;
5001 vms_retpw.pw_gid = up->uaf$w_grp;
5002
5003 /* I suppose this is not the best sytle, to possibly overwrite one
5004 byte beyond the end of the field, but what the heck... */
5005 ptr = &up->uaf$t_username[UAF$S_USERNAME];
5006 while (ptr[-1] == ' ')
5007 ptr--;
5008 *ptr = '\0';
5009 strcpy (vms_retpw.pw_name, up->uaf$t_username);
5010
5011 /* the rest of these are counted ascii strings */
5012 strncpy (vms_retpw.pw_gecos, &up->uaf$t_owner[1], up->uaf$t_owner[0]);
5013 vms_retpw.pw_gecos[up->uaf$t_owner[0]] = '\0';
5014 strncpy (vms_retpw.pw_dir, &up->uaf$t_defdev[1], up->uaf$t_defdev[0]);
5015 vms_retpw.pw_dir[up->uaf$t_defdev[0]] = '\0';
5016 strncat (vms_retpw.pw_dir, &up->uaf$t_defdir[1], up->uaf$t_defdir[0]);
5017 vms_retpw.pw_dir[up->uaf$t_defdev[0] + up->uaf$t_defdir[0]] = '\0';
5018 strncpy (vms_retpw.pw_shell, &up->uaf$t_defcli[1], up->uaf$t_defcli[0]);
5019 vms_retpw.pw_shell[up->uaf$t_defcli[0]] = '\0';
5020
5021 return &vms_retpw;
5022 }
5023 #else /* not READ_SYSUAF */
5024 static struct passwd vms_retpw;
5025 #endif /* not READ_SYSUAF */
5026
5027 struct passwd *
5028 getpwnam (char *name)
5029 {
5030 #ifdef READ_SYSUAF
5031 struct UAF *up;
5032 #else
5033 char * user;
5034 char * dir;
5035 unsigned char * full;
5036 #endif /* READ_SYSUAF */
5037 char *ptr = name;
5038
5039 while (*ptr)
5040 {
5041 *ptr = toupper (* (unsigned char *) ptr);
5042 ptr++;
5043 }
5044 #ifdef READ_SYSUAF
5045 if (!(up = get_uaf_name (name)))
5046 return 0;
5047 return cnv_uaf_pw (up);
5048 #else
5049 if (strcmp (name, getenv ("USER")) == 0)
5050 {
5051 vms_retpw.pw_uid = getuid ();
5052 vms_retpw.pw_gid = getgid ();
5053 strcpy (vms_retpw.pw_name, name);
5054 if (full = egetenv ("FULLNAME"))
5055 strcpy (vms_retpw.pw_gecos, full);
5056 else
5057 *vms_retpw.pw_gecos = '\0';
5058 strcpy (vms_retpw.pw_dir, egetenv ("HOME"));
5059 *vms_retpw.pw_shell = '\0';
5060 return &vms_retpw;
5061 }
5062 else
5063 return 0;
5064 #endif /* not READ_SYSUAF */
5065 }
5066
5067 struct passwd *
5068 getpwuid (unsigned long uid)
5069 {
5070 #ifdef READ_SYSUAF
5071 struct UAF * up;
5072
5073 if (!(up = get_uaf_uic (uid)))
5074 return 0;
5075 return cnv_uaf_pw (up);
5076 #else
5077 if (uid == sys_getuid ())
5078 return getpwnam (egetenv ("USER"));
5079 else
5080 return 0;
5081 #endif /* not READ_SYSUAF */
5082 }
5083
5084 /* return total address space available to the current process. This is
5085 the sum of the current p0 size, p1 size and free page table entries
5086 available. */
5087 int
5088 vlimit (void)
5089 {
5090 int item_code;
5091 unsigned long free_pages;
5092 unsigned long frep0va;
5093 unsigned long frep1va;
5094 status;
5095
5096 item_code = JPI$_FREPTECNT;
5097 if (((status = LIB$GETJPI (&item_code, 0, 0, &free_pages)) & 1) == 0)
5098 {
5099 errno = EVMSERR;
5100 vaxc$errno = status;
5101 return -1;
5102 }
5103 free_pages *= 512;
5104
5105 item_code = JPI$_FREP0VA;
5106 if (((status = LIB$GETJPI (&item_code, 0, 0, &frep0va)) & 1) == 0)
5107 {
5108 errno = EVMSERR;
5109 vaxc$errno = status;
5110 return -1;
5111 }
5112 item_code = JPI$_FREP1VA;
5113 if (((status = LIB$GETJPI (&item_code, 0, 0, &frep1va)) & 1) == 0)
5114 {
5115 errno = EVMSERR;
5116 vaxc$errno = status;
5117 return -1;
5118 }
5119
5120 return free_pages + frep0va + (0x7fffffff - frep1va);
5121 }
5122
5123 int
5124 define_logical_name (char *varname, char *string)
5125 {
5126 struct dsc$descriptor_s strdsc =
5127 {strlen (string), DSC$K_DTYPE_T, DSC$K_CLASS_S, string};
5128 struct dsc$descriptor_s envdsc =
5129 {strlen (varname), DSC$K_DTYPE_T, DSC$K_CLASS_S, varname};
5130 struct dsc$descriptor_s lnmdsc =
5131 {7, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$JOB"};
5132
5133 return LIB$SET_LOGICAL (&envdsc, &strdsc, &lnmdsc, 0, 0);
5134 }
5135
5136 int
5137 delete_logical_name (char *varname)
5138 {
5139 struct dsc$descriptor_s envdsc =
5140 {strlen (varname), DSC$K_DTYPE_T, DSC$K_CLASS_S, varname};
5141 struct dsc$descriptor_s lnmdsc =
5142 {7, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$JOB"};
5143
5144 return LIB$DELETE_LOGICAL (&envdsc, &lnmdsc);
5145 }
5146
5147 execvp (void)
5148 {
5149 error ("execvp system call not implemented");
5150 }
5151
5152 int
5153 rename (char *from, char *to)
5154 {
5155 int status;
5156 struct FAB from_fab = cc$rms_fab, to_fab = cc$rms_fab;
5157 struct NAM from_nam = cc$rms_nam, to_nam = cc$rms_nam;
5158 char from_esn[NAM$C_MAXRSS];
5159 char to_esn[NAM$C_MAXRSS];
5160
5161 from_fab.fab$l_fna = from;
5162 from_fab.fab$b_fns = strlen (from);
5163 from_fab.fab$l_nam = &from_nam;
5164 from_fab.fab$l_fop = FAB$M_NAM;
5165
5166 from_nam.nam$l_esa = from_esn;
5167 from_nam.nam$b_ess = sizeof from_esn;
5168
5169 to_fab.fab$l_fna = to;
5170 to_fab.fab$b_fns = strlen (to);
5171 to_fab.fab$l_nam = &to_nam;
5172 to_fab.fab$l_fop = FAB$M_NAM;
5173
5174 to_nam.nam$l_esa = to_esn;
5175 to_nam.nam$b_ess = sizeof to_esn;
5176
5177 status = SYS$RENAME (&from_fab, 0, 0, &to_fab);
5178
5179 if (status & 1)
5180 return 0;
5181 else
5182 {
5183 if (status == RMS$_DEV)
5184 errno = EXDEV;
5185 else
5186 errno = EVMSERR;
5187 vaxc$errno = status;
5188 return -1;
5189 }
5190 }
5191
5192 /* This function renames a file like `rename', but it strips
5193 the version number from the "to" filename, such that the "to" file is
5194 will always be a new version. It also sets the file protection once it is
5195 finished. The protection that we will use is stored in vms_fab_final_pro,
5196 and was set when we did a creat_copy_attrs to create the file that we
5197 are renaming.
5198
5199 We could use the chmod function, but Eunichs uses 3 bits per user category
5200 to describe the protection, and VMS uses 4 (write and delete are separate
5201 bits). To maintain portability, the VMS implementation of `chmod' wires
5202 the W and D bits together. */
5203
5204
5205 static char vms_file_written[NAM$C_MAXRSS];
5206
5207 int
5208 rename_sans_version (char *from, char *to)
5209 {
5210 short int chan;
5211 int stat;
5212 short int iosb[4];
5213 int status;
5214 struct fibdef fib;
5215 struct FAB to_fab = cc$rms_fab;
5216 struct NAM to_nam = cc$rms_nam;
5217 struct dsc$descriptor fib_d ={sizeof (fib),0,0,(char*) &fib};
5218 struct dsc$descriptor fib_attr[2]
5219 = {{sizeof (vms_fab_final_pro),ATR$C_FPRO,0,(char*) &vms_fab_final_pro},{0,0,0,0}};
5220 char to_esn[NAM$C_MAXRSS];
5221
5222 $DESCRIPTOR (disk,to_esn);
5223
5224 memset (&fib, 0, sizeof (fib));
5225
5226 to_fab.fab$l_fna = to;
5227 to_fab.fab$b_fns = strlen (to);
5228 to_fab.fab$l_nam = &to_nam;
5229 to_fab.fab$l_fop = FAB$M_NAM;
5230
5231 to_nam.nam$l_esa = to_esn;
5232 to_nam.nam$b_ess = sizeof to_esn;
5233
5234 status = SYS$PARSE (&to_fab, 0, 0); /* figure out the full file name */
5235
5236 if (to_nam.nam$l_fnb && NAM$M_EXP_VER)
5237 *(to_nam.nam$l_ver) = '\0';
5238
5239 stat = rename (from, to_esn);
5240 if (stat < 0)
5241 return stat;
5242
5243 strcpy (vms_file_written, to_esn);
5244
5245 to_fab.fab$l_fna = vms_file_written; /* this points to the versionless name */
5246 to_fab.fab$b_fns = strlen (vms_file_written);
5247
5248 /* Now set the file protection to the correct value */
5249 SYS$OPEN (&to_fab, 0, 0); /* This fills in the nam$w_fid fields */
5250
5251 /* Copy these fields into the fib */
5252 fib.fib$r_fid_overlay.fib$w_fid[0] = to_nam.nam$w_fid[0];
5253 fib.fib$r_fid_overlay.fib$w_fid[1] = to_nam.nam$w_fid[1];
5254 fib.fib$r_fid_overlay.fib$w_fid[2] = to_nam.nam$w_fid[2];
5255
5256 SYS$CLOSE (&to_fab, 0, 0);
5257
5258 stat = SYS$ASSIGN (&disk, &chan, 0, 0); /* open a channel to the disk */
5259 if (!stat)
5260 LIB$SIGNAL (stat);
5261 stat = SYS$QIOW (0, chan, IO$_MODIFY, iosb, 0, 0, &fib_d,
5262 0, 0, 0, &fib_attr, 0);
5263 if (!stat)
5264 LIB$SIGNAL (stat);
5265 stat = SYS$DASSGN (chan);
5266 if (!stat)
5267 LIB$SIGNAL (stat);
5268 strcpy (vms_file_written, to_esn); /* We will write this to the terminal*/
5269 return 0;
5270 }
5271
5272 int
5273 link (char *file, char *new)
5274 {
5275 status;
5276 struct FAB fab;
5277 struct NAM nam;
5278 unsigned short fid[3];
5279 char esa[NAM$C_MAXRSS];
5280
5281 fab = cc$rms_fab;
5282 fab.fab$l_fop = FAB$M_OFP;
5283 fab.fab$l_fna = file;
5284 fab.fab$b_fns = strlen (file);
5285 fab.fab$l_nam = &nam;
5286
5287 nam = cc$rms_nam;
5288 nam.nam$l_esa = esa;
5289 nam.nam$b_ess = NAM$C_MAXRSS;
5290
5291 status = SYS$PARSE (&fab);
5292 if ((status & 1) == 0)
5293 {
5294 errno = EVMSERR;
5295 vaxc$errno = status;
5296 return -1;
5297 }
5298 status = SYS$SEARCH (&fab);
5299 if ((status & 1) == 0)
5300 {
5301 errno = EVMSERR;
5302 vaxc$errno = status;
5303 return -1;
5304 }
5305
5306 fid[0] = nam.nam$w_fid[0];
5307 fid[1] = nam.nam$w_fid[1];
5308 fid[2] = nam.nam$w_fid[2];
5309
5310 fab.fab$l_fna = new;
5311 fab.fab$b_fns = strlen (new);
5312
5313 status = SYS$PARSE (&fab);
5314 if ((status & 1) == 0)
5315 {
5316 errno = EVMSERR;
5317 vaxc$errno = status;
5318 return -1;
5319 }
5320
5321 nam.nam$w_fid[0] = fid[0];
5322 nam.nam$w_fid[1] = fid[1];
5323 nam.nam$w_fid[2] = fid[2];
5324
5325 nam.nam$l_esa = nam.nam$l_name;
5326 nam.nam$b_esl = nam.nam$b_name + nam.nam$b_type + nam.nam$b_ver;
5327
5328 status = SYS$ENTER (&fab);
5329 if ((status & 1) == 0)
5330 {
5331 errno = EVMSERR;
5332 vaxc$errno = status;
5333 return -1;
5334 }
5335
5336 return 0;
5337 }
5338
5339 #ifdef getenv
5340 /* If any place else asks for the TERM variable,
5341 allow it to be overridden with the EMACS_TERM variable
5342 before attempting to translate the logical name TERM. As a last
5343 resort, ask for VAX C's special idea of the TERM variable. */
5344 #undef getenv
5345 char *
5346 sys_getenv (char *name)
5347 {
5348 char *val;
5349 static char buf[256];
5350 static struct dsc$descriptor_s equiv
5351 = {sizeof (buf), DSC$K_DTYPE_T, DSC$K_CLASS_S, buf};
5352 static struct dsc$descriptor_s d_name
5353 = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
5354 short eqlen;
5355
5356 if (!strcmp (name, "TERM"))
5357 {
5358 val = (char *) getenv ("EMACS_TERM");
5359 if (val)
5360 return val;
5361 }
5362
5363 d_name.dsc$w_length = strlen (name);
5364 d_name.dsc$a_pointer = name;
5365 if (LIB$SYS_TRNLOG (&d_name, &eqlen, &equiv) == 1)
5366 {
5367 char *str = (char *) xmalloc (eqlen + 1);
5368 memcpy (str, buf, eqlen);
5369 str[eqlen] = '\0';
5370 /* This is a storage leak, but a pain to fix. With luck,
5371 no one will ever notice. */
5372 return str;
5373 }
5374 return (char *) getenv (name);
5375 }
5376 #endif /* getenv */
5377
5378 #ifdef abort
5379 /* Since VMS doesn't believe in core dumps, the only way to debug this beast is
5380 to force a call on the debugger from within the image. */
5381 #undef abort
5382 sys_abort (void)
5383 {
5384 reset_all_consoles ();
5385 LIB$SIGNAL (SS$_DEBUG);
5386 }
5387 #endif /* abort */
5388
5389 #if 0 /* Apparently unused */
5390 /* The standard `sleep' routine works some other way
5391 and it stops working if you have ever quit out of it.
5392 This one continues to work. */
5393
5394 void
5395 sys_sleep (int timeval)
5396 {
5397 int time [2];
5398 static int zero = 0;
5399 static int large = -10000000;
5400
5401 LIB$EMUL (&timeval, &large, &zero, time); /* Convert to VMS format */
5402
5403 SYS$CANTIM (1, 0);
5404 if (SYS$SETIMR (vms_timer_ef, time, 0, 1) & 1) /* Set timer */
5405 SYS$WAITFR (vms_timer_ef); /* Wait for timer expiry only */
5406 }
5407 #endif /* 0 */
5408
5409 void
5410 bzero (REGISTER char *b, REGISTER int length)
5411 {
5412 short zero = 0;
5413 long max_str = 65535;
5414
5415 while (length > max_str) {
5416 (void) LIB$MOVC5 (&zero, &zero, &zero, &max_str, b);
5417 length -= max_str;
5418 b += max_str;
5419 }
5420 max_str = length;
5421 (void) LIB$MOVC5 (&zero, &zero, &zero, &max_str, b);
5422 }
5423
5424 /* Saying `void' requires a declaration, above, where bcopy is used
5425 and that declaration causes pain for systems where bcopy is a macro. */
5426 bcopy (REGISTER char *b1, REGISTER char *b2, REGISTER int length)
5427 {
5428 long max_str = 65535;
5429
5430 while (length > max_str) {
5431 (void) LIB$MOVC3 (&max_str, b1, b2);
5432 length -= max_str;
5433 b1 += max_str;
5434 b2 += max_str;
5435 }
5436 max_str = length;
5437 (void) LIB$MOVC3 (&length, b1, b2);
5438 }
5439
5440 int
5441 bcmp (REGISTER char *b1, REGISTER char *b2, REGISTER int length)
5442 /* This could be a macro! */
5443 {
5444 struct dsc$descriptor_s src1 = {length, DSC$K_DTYPE_T, DSC$K_CLASS_S, b1};
5445 struct dsc$descriptor_s src2 = {length, DSC$K_DTYPE_T, DSC$K_CLASS_S, b2};
5446
5447 return STR$COMPARE (&src1, &src2);
5448 }
5449
5450 #endif /* VMS */
5451 3682
5452 #ifndef HAVE_STRCASECMP 3683 #ifndef HAVE_STRCASECMP
5453 /* 3684 /*
5454 * From BSD 3685 * From BSD
5455 */ 3686 */