1 /* This is the wrapper for dynamically linked executables
3 * Have mercy with this creature born in cross-platform wasteland.
13 #include <ghcplatform.h>
14 #include <shell-tools.c>
16 /* All defining behavior string */
17 char behaviour[]=BEHAVIOUR;
19 #define REAL_EXT "_real"
20 #define REAL_EXT_S (sizeof(REAL_EXT)-1)
22 void *smalloc(size_t size);
24 #if defined(mingw32_HOST_OS)
28 #define ENV_NAME "PATH"
32 #define SET_ENV(n,v) SetEnvironmentVariable(n,v)
33 #define GET_ENV(n) getEnvWrapper(n)
34 #define FREE_GET_ENV(x) free(x)
38 char *getEnvWrapper(const char *name) {
39 int len=GetEnvironmentVariableA(name,NULL,0);
44 GetEnvironmentVariableA(name,value,len);
48 #define CONVERT_PATH(x) replace(x,'/','\\')
51 #elif defined(linux_HOST_OS)
52 #define ENV_NAME "LD_LIBRARY_PATH"
56 #define SET_ENV(n,v) setenv(n,v,1)
57 #define GET_ENV(n) getenv(n)
59 #define FREE_GET_ENV(x)
60 #define CONVERT_PATH(x)
63 #elif defined(darwin_HOST_OS)
64 #define ENV_NAME "DYLD_LIBRARY_PATH"
68 #define SET_ENV(n,v) setenv(n,v,1)
69 #define GET_ENV(n) getenv(n)
70 #define FREE_GET_ENV(x)
72 #define CONVERT_PATH(x)
75 #error no OS interface defined
78 #define EXEEXT_S (sizeof(EXEEXT)-1)
80 /* Utility functions */
82 /* Like strtok_r but omitting the first arg and allowing only one delimiter */
83 char *stringTokenizer (char **this, const char delim)
87 if(!this || !(*this)) return NULL;
89 matched=strchr(*this, delim);
100 /* Replaces all occourances of character 'from' with 'to' in 'x' */
101 void replace(char *x, char from, char to) {
109 /* Non-failing malloc -- will die on failure */
110 void *smalloc(size_t size)
112 void *ret=malloc(size);
114 fprintf(stderr,"Can not allocate %d bytes",size);
121 /* String Cons (scons) -- basically a linked list */
127 /* Free up a linked list */
128 void freescons(struct scons *root) {
130 struct scons *c=root;
137 /* Removes duplicates among the string cons */
138 struct scons *unique(struct scons *in) {
139 struct scons *ret=NULL;
141 for(ci=in; ci!=NULL; ci=ci->next) {
143 struct scons *nextscons;
144 for(cj = ret; cj != NULL; cj=cj->next) {
145 if(!strcmp(ci->value,cj->value))
148 if(cj!=NULL) continue;
150 nextscons=smalloc(sizeof(struct scons));
152 nextscons->value=strdup(ci->value);
158 /* Tries to get a single line from the input stream really _inefficently_ */
159 char *afgets(FILE *input) {
161 char *buf=(char *)malloc(bufsize);
164 buf=realloc(buf,bufsize);
165 } while(fread(buf+bufsize-1,1,1,input)==1 && buf[bufsize-1]!='\n');
170 /* Computes the real binaries' name from argv0 */
171 char *real_binary_name(char *argv0) {
172 int arg0len=strlen(argv0);
175 alterego=strdup(argv0);
176 if(!strcmp(alterego+arg0len-EXEEXT_S,EXEEXT)) {
177 alterego[arg0len-EXEEXT_S]=0;
180 alterego=realloc(alterego,arg0len+REAL_EXT_S+EXEEXT_S+1);
181 sprintf(alterego+arg0len,"%s%s",REAL_EXT,EXEEXT);
185 /* Gets a field for a GHC package
186 * This method can't deal with multiline fields
188 #warning FIXME - getGhcPkgField can not deal with multline fields
190 char *getGhcPkgField(char *ghcpkg, char *package, char *field) {
194 int fieldLn=strlen(field);
196 /* Format ghc-pkg command */
197 command=smalloc(strlen(ghcpkg)+strlen(package)+fieldLn+9);
198 sprintf(command,"%s field %s %s",ghcpkg,package,field);
201 input=popen(command,"r");
204 fprintf(stderr,"Failed to invoke %s", command);
216 /* Check for validity */
217 if(strncmp(line,field,fieldLn)) {
223 /* Cut off "<field>: " in the output and return */
224 strcpy(line,line+fieldLn+2);
228 /* Prepends a prefix to an environment variable.
229 If it is set already, it puts a separator in between */
231 void prependenv(char *name, char *prefix, char sep)
233 char *orig=GET_ENV(name);
236 int prefixlength=strlen(prefix);
238 new=(char *)smalloc(strlen(orig)+prefixlength+2);
241 new[prefixlength]=sep;
242 strcpy(new+prefixlength+1,orig);
247 SET_ENV(name,prefix);
252 /* This function probes the library-dirs of all package dependencies,
253 removes duplicates and adds it to the environment ENV_NAME */
254 void withghcpkg(char *ghcpkg, char *packages)
256 struct scons *rootlist=NULL;
257 struct scons *uniqueRootlist=NULL;
260 /* Save pointers for strtok */
266 while(curpack=stringTokenizer(&packages,';')) {
267 #warning We should query for a dynamic-library field not library-dirs.
268 char *line=getGhcPkgField(ghcpkg, curpack,"library-dirs");
269 char *line_p=line; /* need to retain original line for freeing */
273 fprintf(stderr,"Can not query ghc-pkg for fields of packages %s",curpack);
278 while(curlib=stringTokenizer(&line_p,' ')) {
279 c=smalloc(sizeof(struct scons));
281 c->value=strdup(curlib);
286 uniqueRootlist=unique(rootlist);
287 for(c = uniqueRootlist; c != NULL; c=c->next) {
288 CONVERT_PATH(c->value);
289 prependenv(ENV_NAME,c->value,ENV_SEP);
292 freescons(uniqueRootlist);
295 void add_to(char **base, int *base_size, char **target, const char *src, int src_size) {
296 if((*target)-(*base)+src_size > *base_size) {
297 *base=realloc(*base,*base_size+src_size);
298 *base_size=*base_size+src_size;
300 memcpy(*target,src,src_size);
301 *target=*target+src_size;
304 /* Scans str and constructs */
305 char *expandFlexiblePath(char *str)
307 int buffersize=strlen(str)+1;
308 char *base=smalloc(buffersize);
311 while(*str && *str!=';') {
312 if(*str=='$' && *(str+1)=='{') {
318 while(*str && *str != '}') {
323 fprintf(stderr,"End of string while scanning environment variable. Wrapper broken\n");
328 envcont=GET_ENV(start);
330 fprintf(stderr,"Referenced environment variable %s not set.",start);
334 add_to(&base,&buffersize,¤t,envcont,strlen(envcont));
335 FREE_GET_ENV(envcont);
337 add_to(&base,&buffersize,¤t,str,1);
344 char *getBasename(const char *path) {
347 for(i=strlen(path); i>=0; i--) {
348 if(path[i]==DIR_SEP) break;
358 while(!getcwd(cwd,size)) {
360 cwd=realloc(cwd,size);
365 int main(int argc, char **argv) {
367 int arg0len=strlen(argv[0]);
368 switch(behaviour[0]) {
369 case 'H': /* hard paths */
370 replace(behaviour+1,';',ENV_SEP);
371 CONVERT_PATH(behaviour+1);
372 prependenv(ENV_NAME,behaviour+1,ENV_SEP);
375 { /* flexible paths based on ghc-pkg in $GHC_PKG */
377 char *arg0base=getBasename(argv[0]);
378 char *ghc_pkg=behaviour+1;
380 char *oldwd=agetcwd();
382 packages=strchr(behaviour+1,';');
385 expanded=expandFlexiblePath(ghc_pkg);
387 #warning Will this also change drive on windows? WINDOWS IS SO BROKEN.
390 withghcpkg(expanded,packages);
397 printf("unset wrapper called\n");
400 alterego=real_binary_name(argv[0]);
401 return run(argv[0],alterego,argc,argv);