1 is_acceptable_license <- function(license,verbose=FALSE,debug=FALSE) {
2 if (verbose) cat("is_acceptable_license: license:",license,"\n",sep="")
3 # determine if license text is acceptable
5 if (length(grep('^file ',license))) {
7 notice("The package has a file license. This needs individual checking and settings in the respective table.")
10 license <- license_text_reduce(license)
11 if (debug) cat("**** a ****\n")
12 action = db_license_override_name(license)
14 cat("**** action: ****\n")
17 if (!is.null(action)) {
18 if (debug) cat("**** c1 ****\n")
19 #return(isTRUE(action))
22 if (debug) cat("**** c ****\n")
23 license <- license_text_further_reduce(license)
24 if (debug) cat("**** d ****\n")
25 action = db_license_override_name(license)
26 if (debug) cat("**** e ****\n")
27 if (!is.null(action)) {
28 warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!')
31 license <- license_text_extreme_reduce(license)
32 if (debug) cat("**** f ****\n")
33 action = db_license_override_name(license)
34 if (debug) cat("**** g ****\n")
35 if (!is.null(action)) {
36 warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!')
39 error('is_acceptable_license: Wild license',license,'did not match classic rules; rejecting.')
43 license_text_reduce <- function(license,verbose=FALSE,debug=FALSE) {
44 if (verbose) cat("license_text_reduce license:",license,"\n",sep="")
45 # these reduction steps are sound for all conformant R license
48 if (Encoding(license) == "unknown")
49 Encoding(license) <- "latin1" # or should it be UTF-8 ?
51 ## compress spaces into a single space
52 license = gsub('[[:space:]]+',' ',license)
53 # make all characters lower case
54 license = tolower(license)
55 # don't care about versions of licenses
56 license = chomp(sub('\\( ?[<=>!]+ ?[0-9.-]+ ?\\)',''
57 ,sub('-[0-9.-]+','',license)))
58 # remove any extra space introduced
59 license = chomp(gsub('[[:space:]]+',' ',license))
60 if (debug) cat("license_text_reduce: ",license,"\n",sep="")
64 license_text_further_reduce <- function(license,verbose=TRUE) {
65 if (verbose) cat("license_text_further_reduce license:",license,"\n",sep="")
66 # these reduction steps are heuristic and may lead to
67 # in correct acceptances, if care is not taken.
70 license = gsub('http://www.gnu.org/[[:alnum:]/._-]*','',license)
71 license = gsub('http://www.x.org/[[:alnum:]/._-]*','',license)
72 license = gsub('http://www.opensource.org/[[:alnum:]/._-]*','',license)
73 # remove all punctuation
74 license = gsub('[[:punct:]]+','',license)
75 # remove any extra space introduced
76 license = chomp(gsub('[[:space:]]+',' ',license))
78 license = gsub('the','',license)
79 license = gsub('see','',license)
80 license = gsub('standard','',license)
81 license = gsub('licen[sc]e','',license)
82 license = gsub('(gnu )?(gpl|general public)','gpl',license)
83 license = gsub('(mozilla )?(mpl|mozilla public)','mpl',license)
84 # remove any extra space introduced
85 license = chomp(gsub('[[:space:]]+',' ',license))
89 license_text_extreme_reduce <- function(license,verbose=TRUE) {
90 if (verbose) cat("license_text_extreme_reduce license:",license,"\n",sep="")
91 # remove everything that may or may not be a version specification
92 license = gsub('(ver?sion|v)? *[0-9.-]+ *(or *(higher|later|newer|greater|above))?',''
94 # remove any extra space introduced
95 license = chomp(gsub('[[:space:]]+',' ',license))
99 license_text_hash_reduce <- function(text,verbose=TRUE) {
100 if (verbose) cat("license_text_hash_reduce text:",text,"\n",sep="")
101 # reduction of license text, suitable for hashing.
102 return(chomp(tolower(gsub('[[:space:]]+',' ',text))))
105 get_license <- function(pkg,license) {
106 license <- chomp(gsub('[[:space:]]+',' ',license))
107 if (length(grep('^file ',license))) {
108 if (length(grep('^file LICEN[CS]E$',license))) {
109 file = gsub('file ','',license)
110 path = file.path(pkg$path, file)
111 if (file.exists(path)) {
112 #license <- license_text_reduce(readChar(path,file.info(path)$size))
113 con <- file(path, "rb")
114 content <- paste(readLines(con), collapse="\n")
116 license <- license_text_reduce(content)
118 path = file.path(pkg$path, 'inst', file)
119 if (file.exists(path)) {
120 #license <- license_text_reduce(readChar(path,file.info(path)$size))
121 con <- file(path, "rb")
122 content <- paste(readLines(con), collapse="\n")
124 license <- license_text_reduce(content)
126 error('said to look at a license file but license file is missing')
130 error('invalid license file specification',license)
137 get_license_hash <- function(pkg,license) {
138 return(digest(get_license(pkg,license),algo='sha1',serialize=FALSE))
141 is_acceptable_hash_license <- function(pkg,license,verbose=TRUE) {
142 license_sha1 <- get_license_hash(pkg,license)
143 if (is.null(license_sha1)) {
144 if (verbose) cat("is_acceptable_hash_license: get_license_hash(pkg,license) returned NULL, returning FALSE.\n")
147 action = db_license_override_hash(license_sha1)
148 if (is.null(action)) {
149 if (verbose) cat("is_acceptable_hash_license: get_license_override_hash(license_sha1) returned NULL, returning FALSE.\n")
151 } else if (0 == length(action)) {
152 notice("An error occurred, 0==length(action), ignoring package.\n")
154 } else if (is.na(action)) {
155 notice("An error occurred, is.na(action), ignoring package.\n")
159 warn('Wild license',license,'accepted via hash',license_sha1)
165 accept_license <- function(pkg,verbose=FALSE) {
167 if (!('License' %in% names(pkg$description[1,]))) {
168 fail('package has no License: field in description!')
172 if (verbose) { cat("accept_license: pkg:\n"); print(pkg$srcname) }
173 license<-pkg$description[1,'License']
174 if (verbose) { cat(" license:\n"); print(license) }
176 for (l in strsplit(chomp(license),'[[:space:]]*\\|[[:space:]]*')[[1]]) {
177 if (verbose) cat("Investigating: '",l,"'\n",sep="")
178 if (is_acceptable_license(l)) {
181 } else if (is_acceptable_hash_license(pkg,l)) {
185 notice(paste("Could not accept license ",l," for package ",pkg,"\n",sep=""))
188 if (is.null(accept)) {
189 fail('No acceptable license:',pkg$description[1,'License'])
191 notice('Auto-accepted license',accept)
193 if (accept == 'Unlimited') {
194 # definition of Unlimited from ``Writing R extensions''
195 accept=paste('Unlimited (no restrictions on distribution or'
196 ,'use other than those imposed by relevant laws)')