src/main/Renviron.c - R - Git at Google

 /*
  *   R : A Computer Language for Statistical Data Analysis
  *   Copyright (C) 1997-2015   The R Core Team
  *
  *  This program is free software; you can redistribute it and/or modify
  *  it under the terms of the GNU General Public License as published by
  *  the Free Software Foundation; either version 2 of the License, or
  *  (at your option) any later version.
  *
  *  This program is distributed in the hope that it will be useful,
  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  *  GNU General Public License for more details.
  *
  *  You should have received a copy of the GNU General Public License
  *  along with this program; if not, a copy is available at
  *  https://www.R-project.org/Licenses/
  */

 /* <UTF8> This does byte-level access, e.g. isspace, but is OK. */

 /* ------------------- process .Renviron files in C -----------------
  *  Formerly part of ../unix/sys-common.c.
  */

 #ifdef HAVE_CONFIG_H
 #include <config.h>
 #endif

 #include <stdlib.h> /* for setenv or putenv */
 #include <Defn.h> /* for PATH_MAX */
 #include <Rinterface.h>
 #include <Fileio.h>
 #include <ctype.h>		/* for isspace */

 /* remove leading and trailing space */
 static char *rmspace(char *s)
 {
     ssize_t i; // to be safe

     for (i = strlen(s) - 1; i >= 0 && isspace((int)s[i]); i--) s[i] = '\0';
     for (i = 0; isspace((int)s[i]); i++);
     return s + i;
 }

 /* look for ${FOO-bar} or ${FOO:-bar} constructs, recursively.
    return "" on an error condition.
  */

 static char *subterm(char *s)
 {
     char *p, *q;

     if(strncmp(s, "${", 2)) return s;
     if(s[strlen(s) - 1] != '}') return s;
     /*  remove leading ${ and final } */
     s[strlen(s) - 1] = '\0';
     s += 2;
     s = rmspace(s);
     if(!strlen(s)) return "";
     p = Rf_strchr(s, '-');
     if(p) {
 	q = p + 1; /* start of value */
 	if(p - s > 1 && *(p-1) == ':') *(p-1) = '\0'; else *p = '\0';
     } else q = NULL;
     p = getenv(s);
     if(p && strlen(p)) return p; /* variable was set and non-empty */
     return q ? subterm(q) : (char *) "";
 }

 /* skip along until we find an unmatched right brace */
 static char *findRbrace(char *s)
 {
     char *p = s, *pl, *pr;
     int nl = 0, nr = 0;

     while(nr <= nl) {
 	pl = Rf_strchr(p, '{');
 	pr = Rf_strchr(p, '}');
 	if(!pr) return NULL;
 	if(!pl || pr < pl) {
 	    p = pr+1; nr++;
 	} else {
 	    p = pl+1; nl++;
 	}
     }
     return pr;
 }

 #define BUF_SIZE 10000
 static char *findterm(char *s)
 {
     char *p, *q, *r2, *ss=s;
     static char ans[BUF_SIZE];

     if(!strlen(s)) return "";
     ans[0] = '\0';
     while(1) {
 	/* Look for ${...}, taking care to look for inner matches */
 	p = Rf_strchr(s, '$');
 	if(!p || p[1] != '{') break;
 	q = findRbrace(p+2);
 	if(!q) break;
 	/* copy over leading part */
 	size_t nans = strlen(ans);
 	strncat(ans, s, (size_t) (p - s)); ans[nans + p - s] = '\0';
 	char r[q - p + 2];
 	strncpy(r, p, (size_t) (q - p + 1));
 	r[q - p + 1] = '\0';
 	r2 = subterm(r);
 	if(strlen(ans) + strlen(r2) < BUF_SIZE) strcat(ans, r2); else return ss;
 	/* now repeat on the tail */
 	s = q+1;
     }
     if(strlen(ans) + strlen(s) < BUF_SIZE) strcat(ans, s); else return ss;
     return ans;
 }

 static void Putenv(char *a, char *b)
 {
     char *buf, *value, *p, *q, quote='\0';
     int inquote = 0;

 #ifdef HAVE_SETENV
     buf = (char *) malloc((strlen(b) + 1) * sizeof(char));
     if(!buf) R_Suicide("allocation failure in reading Renviron");
     value = buf;
 #else
     buf = (char *) malloc((strlen(a) + strlen(b) + 2) * sizeof(char));
     if(!buf) R_Suicide("allocation failure in reading Renviron");
     strcpy(buf, a); strcat(buf, "=");
     value = buf+strlen(buf);
 #endif

     /* now process the value */
     for(p = b, q = value; *p; p++) {
 	/* remove quotes around sections, preserve \ inside quotes */
 	if(!inquote && (*p == '"' || *p == '\'')) {
 	    inquote = 1;
 	    quote = *p;
 	    continue;
 	}
 	if(inquote && *p == quote && *(p-1) != '\\') {
 	    inquote = 0;
 	    continue;
 	}
 	if(!inquote && *p == '\\') {
 	    if(*(p+1) == '\n') p++;
 	    else if(*(p+1) == '\\') *q++ = *p;
 	    continue;
 	}
 	if(inquote && *p == '\\' && *(p+1) == quote) continue;
 	*q++ = *p;
     }
     *q = '\0';
 #ifdef HAVE_SETENV
     if(setenv(a, buf, 1))
 	warningcall(R_NilValue,
 		    _("problem in setting variable '%s' in Renviron"), a);
     free(buf);
 #elif defined(HAVE_PUTENV)
     if(putenv(buf))
 	warningcall(R_NilValue,
 		    _("problem in setting variable '%s' in Renviron"), a);
     /* no free here: storage remains in use */
 #else
     /* pretty pointless, and was not tested prior to 2.3.0 */
     free(buf);
 #endif
 }


 #define MSG_SIZE 2000
 static int process_Renviron(const char *filename)
 {
     FILE *fp;
     char *s, *p, sm[BUF_SIZE], *lhs, *rhs, msg[MSG_SIZE+50];
     int errs = 0;

     if (!filename || !(fp = R_fopen(filename, "r"))) return 0;
     snprintf(msg, MSG_SIZE+50,
 	     "\n   File %s contains invalid line(s)", filename);

     while(fgets(sm, BUF_SIZE, fp)) {
 	sm[BUF_SIZE-1] = '\0';
 	s = rmspace(sm);
 	if(strlen(s) == 0 || s[0] == '#') continue;
 	if(!(p = Rf_strchr(s, '='))) {
 	    errs++;
 	    if(strlen(msg) < MSG_SIZE) {
 		strcat(msg, "\n      "); strcat(msg, s);
 	    }
 	    continue;
 	}
 	*p = '\0';
 	lhs = rmspace(s);
 	rhs = findterm(rmspace(p+1));
 	/* set lhs = rhs */
 	if(strlen(lhs) && strlen(rhs)) Putenv(lhs, rhs);
     }
     fclose(fp);
     if (errs) {
 	strcat(msg, "\n   They were ignored\n");
 	R_ShowMessage(msg);
     }
     return 1;
 }


 /* try system Renviron: R_HOME/etc/Renviron.  Unix only. */
 void process_system_Renviron()
 {
     char buf[PATH_MAX];

 #ifdef R_ARCH
     if(strlen(R_Home) + strlen("/etc/Renviron") + strlen(R_ARCH) + 1 > PATH_MAX - 1) {
 	R_ShowMessage("path to system Renviron is too long: skipping");
 	return;
     }
     strcpy(buf, R_Home);
     strcat(buf, "/etc/");
     strcat(buf, R_ARCH);
     strcat(buf, "/Renviron");
 #else
     if(strlen(R_Home) + strlen("/etc/Renviron") > PATH_MAX - 1) {
 	R_ShowMessage("path to system Renviron is too long: skipping");
 	return;
     }
     strcpy(buf, R_Home);
     strcat(buf, "/etc/Renviron");
 #endif
     if(!process_Renviron(buf))
 	R_ShowMessage("cannot find system Renviron");
 }

 #ifdef HAVE_UNISTD_H
 #include <unistd.h> /* for access, R_OK */
 #endif

 /* try site Renviron: R_ENVIRON, then R_HOME/etc/Renviron.site. */
 void process_site_Renviron ()
 {
     char buf[PATH_MAX], *p = getenv("R_ENVIRON");

     if(p) {
 	if(*p) process_Renviron(p);
 	return;
     }
 #ifdef R_ARCH
     if(strlen(R_Home) + strlen("/etc/Renviron.site") + strlen(R_ARCH) > PATH_MAX - 2) {
 	R_ShowMessage("path to arch-specific Renviron.site is too long: skipping");
     } else {
 	snprintf(buf, PATH_MAX, "%s/etc/%s/Renviron.site", R_Home, R_ARCH);
 	if(access(buf, R_OK) == 0) {
 	    process_Renviron(buf);
 	    return;
 	}
     }
 #endif
     if(strlen(R_Home) + strlen("/etc/Renviron.site") > PATH_MAX - 1) {
 	R_ShowMessage("path to Renviron.site is too long: skipping");
 	return;
     }
     snprintf(buf, PATH_MAX, "%s/etc/Renviron.site", R_Home);
     process_Renviron(buf);
 }

 /* try user Renviron: ./.Renviron, then ~/.Renviron */
 void process_user_Renviron()
 {
     const char *s = getenv("R_ENVIRON_USER");

     if(s) {
 	if (*s) process_Renviron(R_ExpandFileName(s));
 	return;
     }

 #ifdef R_ARCH
     char buff[100];
     snprintf(buff, 100, ".Renviron.%s", R_ARCH);
     if( process_Renviron(buff)) return;
 #endif
     if(process_Renviron(".Renviron")) return;
 #ifdef Unix
     s = R_ExpandFileName("~/.Renviron");
 #endif
 #ifdef Win32
     {
 	char buf[1024]; /* MAX_PATH is less than this */
 	/* R_USER is not necessarily set yet, so we have to work harder */
 	s = getenv("R_USER");
 	if(!s) s = getenv("HOME");
 	if(!s) return;
 	snprintf(buf, 1024, "%s/.Renviron", s);
 	s = buf;
     }
 #endif
 #ifdef R_ARCH
     snprintf(buff, 100, "%s.%s", s, R_ARCH);
     if( process_Renviron(buff)) return;
 #endif
     process_Renviron(s);
 }

 SEXP attribute_hidden do_readEnviron(SEXP call, SEXP op, SEXP args, SEXP env)
 {

     checkArity(op, args);
     SEXP x = CAR(args);
     if (!isString(x) || LENGTH(x) != 1)
 	error(_("argument '%s' must be a character string"), "x");
     const char *fn = R_ExpandFileName(translateChar(STRING_ELT(x, 0)));
     int res = process_Renviron(fn);
     if (!res)
 	warning(_("file '%s' cannot be opened for reading"), fn);
     return ScalarLogical(res != 0);
 }
	/*
	* R : A Computer Language for Statistical Data Analysis
	* Copyright (C) 1997-2015 The R Core Team
	*
	* This program is free software; you can redistribute it and/or modify
	* it under the terms of the GNU General Public License as published by
	* the Free Software Foundation; either version 2 of the License, or
	* (at your option) any later version.
	*
	* This program is distributed in the hope that it will be useful,
	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	* GNU General Public License for more details.
	*
	* You should have received a copy of the GNU General Public License
	* along with this program; if not, a copy is available at
	* https://www.R-project.org/Licenses/
	*/

	/* <UTF8> This does byte-level access, e.g. isspace, but is OK. */

	/* ------------------- process .Renviron files in C -----------------
	* Formerly part of ../unix/sys-common.c.
	*/

	#ifdef HAVE_CONFIG_H
	#include <config.h>
	#endif

	#include <stdlib.h> /* for setenv or putenv */
	#include <Defn.h> /* for PATH_MAX */
	#include <Rinterface.h>
	#include <Fileio.h>
	#include <ctype.h> /* for isspace */

	/* remove leading and trailing space */
	static char rmspace(char s)
	{
	ssize_t i; // to be safe

	for (i = strlen(s) - 1; i >= 0 && isspace((int)s[i]); i--) s[i] = '\0';
	for (i = 0; isspace((int)s[i]); i++);
	return s + i;
	}

	/* look for ${FOO-bar} or ${FOO:-bar} constructs, recursively.
	return "" on an error condition.
	*/

	static char subterm(char s)
	{
	char p, q;

	if(strncmp(s, "${", 2)) return s;
	if(s[strlen(s) - 1] != '}') return s;
	/* remove leading ${ and final } */
	s[strlen(s) - 1] = '\0';
	s += 2;
	s = rmspace(s);
	if(!strlen(s)) return "";
	p = Rf_strchr(s, '-');
	if(p) {
	q = p + 1; /* start of value */
	if(p - s > 1 && (p-1) == ':') (p-1) = '\0'; else *p = '\0';
	} else q = NULL;
	p = getenv(s);
	if(p && strlen(p)) return p; /* variable was set and non-empty */
	return q ? subterm(q) : (char *) "";
	}

	/* skip along until we find an unmatched right brace */
	static char findRbrace(char s)
	{
	char p = s, pl, *pr;
	int nl = 0, nr = 0;

	while(nr <= nl) {
	pl = Rf_strchr(p, '{');
	pr = Rf_strchr(p, '}');
	if(!pr) return NULL;
	if(!pl \|\| pr < pl) {
	p = pr+1; nr++;
	} else {
	p = pl+1; nl++;
	}
	}
	return pr;
	}

	#define BUF_SIZE 10000
	static char findterm(char s)
	{
	char p, q, r2, ss=s;
	static char ans[BUF_SIZE];

	if(!strlen(s)) return "";
	ans[0] = '\0';
	while(1) {
	/* Look for ${...}, taking care to look for inner matches */
	p = Rf_strchr(s, '$');
	if(!p \|\| p[1] != '{') break;
	q = findRbrace(p+2);
	if(!q) break;
	/* copy over leading part */
	size_t nans = strlen(ans);
	strncat(ans, s, (size_t) (p - s)); ans[nans + p - s] = '\0';
	char r[q - p + 2];
	strncpy(r, p, (size_t) (q - p + 1));
	r[q - p + 1] = '\0';
	r2 = subterm(r);
	if(strlen(ans) + strlen(r2) < BUF_SIZE) strcat(ans, r2); else return ss;
	/* now repeat on the tail */
	s = q+1;
	}
	if(strlen(ans) + strlen(s) < BUF_SIZE) strcat(ans, s); else return ss;
	return ans;
	}

	static void Putenv(char a, char b)
	{
	char buf, value, p, q, quote='\0';
	int inquote = 0;

	#ifdef HAVE_SETENV
	buf = (char ) malloc((strlen(b) + 1) sizeof(char));
	if(!buf) R_Suicide("allocation failure in reading Renviron");
	value = buf;
	#else
	buf = (char ) malloc((strlen(a) + strlen(b) + 2) sizeof(char));
	if(!buf) R_Suicide("allocation failure in reading Renviron");
	strcpy(buf, a); strcat(buf, "=");
	value = buf+strlen(buf);
	#endif

	/* now process the value */
	for(p = b, q = value; *p; p++) {
	/* remove quotes around sections, preserve \ inside quotes */
	if(!inquote && (p == '"' \|\| p == '\'')) {
	inquote = 1;
	quote = *p;
	continue;
	}
	if(inquote && p == quote && (p-1) != '\\') {
	inquote = 0;
	continue;
	}
	if(!inquote && *p == '\\') {
	if(*(p+1) == '\n') p++;
	else if((p+1) == '\\') q++ = *p;
	continue;
	}
	if(inquote && p == '\\' && (p+1) == quote) continue;
	q++ = p;
	}
	*q = '\0';
	#ifdef HAVE_SETENV
	if(setenv(a, buf, 1))
	warningcall(R_NilValue,
	_("problem in setting variable '%s' in Renviron"), a);
	free(buf);
	#elif defined(HAVE_PUTENV)
	if(putenv(buf))
	warningcall(R_NilValue,
	_("problem in setting variable '%s' in Renviron"), a);
	/* no free here: storage remains in use */
	#else
	/* pretty pointless, and was not tested prior to 2.3.0 */
	free(buf);
	#endif
	}


	#define MSG_SIZE 2000
	static int process_Renviron(const char *filename)
	{
	FILE *fp;
	char s, p, sm[BUF_SIZE], lhs, rhs, msg[MSG_SIZE+50];
	int errs = 0;

	if (!filename \|\| !(fp = R_fopen(filename, "r"))) return 0;
	snprintf(msg, MSG_SIZE+50,
	"\n File %s contains invalid line(s)", filename);

	while(fgets(sm, BUF_SIZE, fp)) {
	sm[BUF_SIZE-1] = '\0';
	s = rmspace(sm);
	if(strlen(s) == 0 \|\| s[0] == '#') continue;
	if(!(p = Rf_strchr(s, '='))) {
	errs++;
	if(strlen(msg) < MSG_SIZE) {
	strcat(msg, "\n "); strcat(msg, s);
	}
	continue;
	}
	*p = '\0';
	lhs = rmspace(s);
	rhs = findterm(rmspace(p+1));
	/* set lhs = rhs */
	if(strlen(lhs) && strlen(rhs)) Putenv(lhs, rhs);
	}
	fclose(fp);
	if (errs) {
	strcat(msg, "\n They were ignored\n");
	R_ShowMessage(msg);
	}
	return 1;
	}


	/* try system Renviron: R_HOME/etc/Renviron. Unix only. */
	void process_system_Renviron()
	{
	char buf[PATH_MAX];

	#ifdef R_ARCH
	if(strlen(R_Home) + strlen("/etc/Renviron") + strlen(R_ARCH) + 1 > PATH_MAX - 1) {
	R_ShowMessage("path to system Renviron is too long: skipping");
	return;
	}
	strcpy(buf, R_Home);
	strcat(buf, "/etc/");
	strcat(buf, R_ARCH);
	strcat(buf, "/Renviron");
	#else
	if(strlen(R_Home) + strlen("/etc/Renviron") > PATH_MAX - 1) {
	R_ShowMessage("path to system Renviron is too long: skipping");
	return;
	}
	strcpy(buf, R_Home);
	strcat(buf, "/etc/Renviron");
	#endif
	if(!process_Renviron(buf))
	R_ShowMessage("cannot find system Renviron");
	}

	#ifdef HAVE_UNISTD_H
	#include <unistd.h> /* for access, R_OK */
	#endif

	/* try site Renviron: R_ENVIRON, then R_HOME/etc/Renviron.site. */
	void process_site_Renviron ()
	{
	char buf[PATH_MAX], *p = getenv("R_ENVIRON");

	if(p) {
	if(*p) process_Renviron(p);
	return;
	}
	#ifdef R_ARCH
	if(strlen(R_Home) + strlen("/etc/Renviron.site") + strlen(R_ARCH) > PATH_MAX - 2) {
	R_ShowMessage("path to arch-specific Renviron.site is too long: skipping");
	} else {
	snprintf(buf, PATH_MAX, "%s/etc/%s/Renviron.site", R_Home, R_ARCH);
	if(access(buf, R_OK) == 0) {
	process_Renviron(buf);
	return;
	}
	}
	#endif
	if(strlen(R_Home) + strlen("/etc/Renviron.site") > PATH_MAX - 1) {
	R_ShowMessage("path to Renviron.site is too long: skipping");
	return;
	}
	snprintf(buf, PATH_MAX, "%s/etc/Renviron.site", R_Home);
	process_Renviron(buf);
	}

	/* try user Renviron: ./.Renviron, then ~/.Renviron */
	void process_user_Renviron()
	{
	const char *s = getenv("R_ENVIRON_USER");

	if(s) {
	if (*s) process_Renviron(R_ExpandFileName(s));
	return;
	}

	#ifdef R_ARCH
	char buff[100];
	snprintf(buff, 100, ".Renviron.%s", R_ARCH);
	if( process_Renviron(buff)) return;
	#endif
	if(process_Renviron(".Renviron")) return;
	#ifdef Unix
	s = R_ExpandFileName("~/.Renviron");
	#endif
	#ifdef Win32
	{
	char buf[1024]; /* MAX_PATH is less than this */
	/* R_USER is not necessarily set yet, so we have to work harder */
	s = getenv("R_USER");
	if(!s) s = getenv("HOME");
	if(!s) return;
	snprintf(buf, 1024, "%s/.Renviron", s);
	s = buf;
	}
	#endif
	#ifdef R_ARCH
	snprintf(buff, 100, "%s.%s", s, R_ARCH);
	if( process_Renviron(buff)) return;
	#endif
	process_Renviron(s);
	}

	SEXP attribute_hidden do_readEnviron(SEXP call, SEXP op, SEXP args, SEXP env)
	{

	checkArity(op, args);
	SEXP x = CAR(args);
	if (!isString(x) \|\| LENGTH(x) != 1)
	error(_("argument '%s' must be a character string"), "x");
	const char *fn = R_ExpandFileName(translateChar(STRING_ELT(x, 0)));
	int res = process_Renviron(fn);
	if (!res)
	warning(_("file '%s' cannot be opened for reading"), fn);
	return ScalarLogical(res != 0);
	}