1 /* VMS functions
2 Copyright (C) 1996-2022 Free Software Foundation, Inc.
3 This file is part of GNU Make.
4
5 GNU Make is free software; you can redistribute it and/or modify it under the
6 terms of the GNU General Public License as published by the Free Software
7 Foundation; either version 3 of the License, or (at your option) any later
8 version.
9
10 GNU Make is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12 A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13
14 You should have received a copy of the GNU General Public License along with
15 this program. If not, see <https://www.gnu.org/licenses/>. */
16
17 #include "makeint.h"
18 #include "debug.h"
19 #include "job.h"
20
21 #include <ctype.h>
22 #include <string.h>
23
24 #ifdef __DECC
25 #include <starlet.h>
26 #endif
27
28 #include <rms.h>
29 #include "vmsdir.h"
30
31 #ifdef HAVE_VMSDIR_H
32
33 DIR *
34 opendir (char *dspec)
35 {
36 struct DIR *dir = xcalloc (sizeof (struct DIR));
37 struct NAM *dnam = xmalloc (sizeof (struct NAM));
38 struct FAB *dfab = &dir->fab;
39 char *searchspec = xmalloc (MAXNAMLEN + 1);
40
41 *dfab = cc$rms_fab;
42 *dnam = cc$rms_nam;
43 sprintf (searchspec, "%s*.*;", dspec);
44
45 dfab->fab$l_fna = searchspec;
46 dfab->fab$b_fns = strlen (searchspec);
47 dfab->fab$l_nam = dnam;
48
49 *dnam = cc$rms_nam;
50 dnam->nam$l_esa = searchspec;
51 dnam->nam$b_ess = MAXNAMLEN;
52
53 if (! (sys$parse (dfab) & 1))
54 {
55 free (dir);
56 free (dnam);
57 free (searchspec);
58 return (NULL);
59 }
60
61 return dir;
62 }
63
64 #define uppercasify(str) \
65 do \
66 { \
67 char *tmp; \
68 for (tmp = (str); *tmp != '\0'; tmp++) \
69 if (islower ((unsigned char)*tmp)) \
70 *tmp = toupper ((unsigned char)*tmp); \
71 } \
72 while (0)
73
74 struct direct *
75 readdir (DIR *dir)
76 {
77 struct FAB *dfab = &dir->fab;
78 struct NAM *dnam = (struct NAM *)(dfab->fab$l_nam);
79 struct direct *dentry = &dir->dir;
80 int i;
81
82 memset (dentry, 0, sizeof *dentry);
83
84 dnam->nam$l_rsa = dir->d_result;
85 dnam->nam$b_rss = MAXNAMLEN;
86
87 DB (DB_VERBOSE, ("."));
88
89 if (!((i = sys$search (dfab)) & 1))
90 {
91 DB (DB_VERBOSE, (_("sys$search() failed with %d\n"), i));
92 return (NULL);
93 }
94
95 dentry->d_off = 0;
96 if (dnam->nam$w_fid == 0)
97 dentry->d_fileno = 1;
98 else
99 dentry->d_fileno = dnam->nam$w_fid[0] + (dnam->nam$w_fid[1] << 16);
100
101 dentry->d_reclen = sizeof (struct direct);
102 dentry->d_namlen = dnam->nam$b_name + dnam->nam$b_type;
103 strncpy (dentry->d_name, dnam->nam$l_name, dentry->d_namlen);
104 dentry->d_name[dentry->d_namlen] = '\0';
105
106 #ifdef HAVE_CASE_INSENSITIVE_FS
107 uppercasify (dentry->d_name);
108 #endif
109
110 return (dentry);
111 }
112
113 int
114 closedir (DIR *dir)
115 {
116 if (dir != NULL)
117 {
118 struct FAB *dfab = &dir->fab;
119 struct NAM *dnam = (struct NAM *)(dfab->fab$l_nam);
120 if (dnam != NULL)
121 free (dnam->nam$l_esa);
122 free (dnam);
123 free (dir);
124 }
125
126 return 0;
127 }
128 #endif /* compiled for OpenVMS prior to V7.x */
129
130 /* Argv0 will be a full vms file specification, like
131 node$dka100:[utils.gnumake]make.exe;47
132 prefix it with "mcr " to make it a vms command, executable for DCL. */
133 const char *
134 vms_command(const char* argv0)
135 {
136 size_t l = strlen(argv0) + 1;
137 char* s = xmalloc(l + 4);
138 memcpy(s, "mcr ", 4);
139 memcpy(s+4, argv0, l);
140 return s;
141 }
142
143 /* Argv0 aka argv[0] will be a full vms file specification, like
144 node$dka100:[utils.gnumake]make.exe;47, set up by the CRTL.
145 The vms progname should be ^^^^, the file name without
146 file type .exe and ;version.
147 Use sys$parse to get the name part of the file specification. That is
148 in the above example, pick up "make" and return a copy of that string.
149 If something goes wrong in sys$parse (unlikely, this is a VMS/CRTL supplied
150 file specification) or if there is an empty name part (not easy to produce,
151 but it is possible) just return "make".
152 Some notes ...
153 NAM[L]$M_SYNCHK requests a syntax check, only.
154 NAM is for ODS2 names (shorter parts, output usually converted to UPPERCASE).
155 NAML is for ODS2/ODS5 names (longer parts, output unchanged).
156 NAM$M_NO_SHORT_UPCASE may not be available for older versions of VMS.
157 NAML is not available on older versions of VMS (NAML$C_BID not defined).
158 argv[0] on older versions of VMS (no extended parse style and no
159 CRTL feature DECC$ARGV_PARSE_STYLE) is always in lowercase. */
160 const char *
161 vms_progname(const char* argv0)
162 {
163 int status;
164 static struct FAB fab;
165 char *progname;
166 const char *fallback = "make";
167
168 #ifdef NAML$C_BID
169 static char esa[NAML$C_MAXRSS];
170 static struct NAML naml;
171 #else
172 static char esa[NAM$C_MAXRSS];
173 static struct NAM nam;
174 #endif
175
176 fab = cc$rms_fab;
177 fab.fab$l_fna = (char*)argv0;
178 fab.fab$b_fns = strlen(argv0);
179
180 #ifdef NAML$C_BID
181 fab.fab$l_naml = &naml;
182 naml = cc$rms_naml;
183 naml.naml$l_long_expand = esa;
184 naml.naml$l_long_expand_alloc = NAML$C_MAXRSS;
185 naml.naml$b_nop = NAML$M_SYNCHK;
186 naml.naml$l_input_flags = NAML$M_NO_SHORT_OUTPUT;
187 #else
188 fab.fab$l_nam = &nam;
189 nam = cc$rms_nam;
190 nam.nam$l_esa = esa;
191 nam.nam$b_ess = NAM$C_MAXRSS;
192 # ifdef NAM$M_NO_SHORT_UPCASE
193 nam.nam$b_nop = NAM$M_SYNCHK | NAM$M_NO_SHORT_UPCASE;
194 # else
195 nam.nam$b_nop = NAM$M_SYNCHK;
196 # endif
197 #endif
198
199 status = sys$parse(&fab);
200 if (!(status & 1))
201 return fallback;
202
203 #ifdef NAML$C_BID
204 if (naml.naml$l_long_name_size == 0)
205 return fallback;
206 progname = xmalloc(naml.naml$l_long_name_size + 1);
207 memcpy(progname, naml.naml$l_long_name, naml.naml$l_long_name_size);
208 progname[naml.naml$l_long_name_size] = '\0';
209 #else
210 if (nam.nam$b_name == 0)
211 return fallback;
212 progname = xmalloc(nam.nam$b_name + 1);
213 # ifdef NAM$M_NO_SHORT_UPCASE
214 memcpy(progname, nam.nam$l_name, nam.nam$b_name);
215 # else
216 {
217 int i;
218 for (i = 0; i < nam.nam$b_name; i++)
219 progname[i] = tolower(nam.nam$l_name[i]);
220 }
221 # endif
222 progname[nam.nam$b_name] = '\0';
223 #endif
224
225 return progname;
226 }