1 is_acceptable_license <- function(license,verbose=FALSE,debug=FALSE) {
2 if (verbose) cat("is_acceptable_license: license: ",
3 #paste(license,collapse="@",sep=""),
6 # determine if license text is acceptable
8 if (length(grep('^file ',license))) {
10 notice("The package has a file license. This needs individual checking and settings in the respective table.")
13 license <- license_text_reduce(license)
14 if (debug) cat("**** a ****\n")
15 action = db_license_override_name(license)
17 cat("**** action: ****\n")
20 if (!is.null(action)) {
21 if (debug) cat("**** c1 ****\n")
22 #return(isTRUE(action))
25 if (debug) cat("**** c ****\n")
26 license <- license_text_further_reduce(license)
27 if (debug) cat("**** d ****\n")
28 action = db_license_override_name(license)
29 if (debug) cat("**** e ****\n")
30 if (!is.null(action)) {
31 warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!')
34 license <- license_text_extreme_reduce(license)
35 if (debug) cat("**** f ****\n")
36 action = db_license_override_name(license)
37 if (debug) cat("**** g ****\n")
38 if (!is.null(action)) {
39 warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!')
42 error('is_acceptable_license: Wild license',license,'did not match classic rules; rejecting.')
46 license_text_reduce <- function(license,verbose=FALSE,debug=FALSE) {
47 if (verbose) cat("license_text_reduce license:",license,"\n",sep="")
48 # these reduction steps are sound for all conformant R license
51 if (Encoding(license) == "unknown")
52 Encoding(license) <- "latin1" # or should it be UTF-8 ?
54 ## compress spaces into a single space
55 license = gsub('[[:space:]]+',' ',license)
56 # make all characters lower case
57 license = tolower(license)
58 # don't care about versions of licenses
59 license = chomp(sub('\\( ?[<=>!]+ ?[0-9.-]+ ?\\)',''
60 ,sub('-[0-9.-]+','',license)))
61 # remove any extra space introduced
62 license = chomp(gsub('[[:space:]]+',' ',license))
63 if (debug) cat("license_text_reduce: ",license,"\n",sep="")
67 license_text_further_reduce <- function(license,verbose=TRUE) {
68 if (verbose) cat("license_text_further_reduce license:",license,"\n",sep="")
69 # these reduction steps are heuristic and may lead to
70 # in correct acceptances, if care is not taken.
73 license = gsub('http://www.gnu.org/[[:alnum:]/._-]*','',license)
74 license = gsub('http://www.x.org/[[:alnum:]/._-]*','',license)
75 license = gsub('http://www.opensource.org/[[:alnum:]/._-]*','',license)
76 # remove all punctuation
77 license = gsub('[[:punct:]]+','',license)
78 # remove any extra space introduced
79 license = chomp(gsub('[[:space:]]+',' ',license))
81 license = gsub('the','',license)
82 license = gsub('see','',license)
83 license = gsub('standard','',license)
84 license = gsub('licen[sc]e','',license)
85 license = gsub('(gnu )?(gpl|general public)','gpl',license)
86 license = gsub('(mozilla )?(mpl|mozilla public)','mpl',license)
87 # remove any extra space introduced
88 license = chomp(gsub('[[:space:]]+',' ',license))
92 license_text_extreme_reduce <- function(license,verbose=TRUE) {
93 if (verbose) cat("license_text_extreme_reduce license:",license,"\n",sep="")
94 # remove everything that may or may not be a version specification
95 license = gsub('(ver?sion|v)? *[0-9.-]+ *(or *(higher|later|newer|greater|above))?',''
97 # remove any extra space introduced
98 license = chomp(gsub('[[:space:]]+',' ',license))
102 license_text_hash_reduce <- function(text,verbose=TRUE) {
103 if (verbose) cat("license_text_hash_reduce text:",text,"\n",sep="")
104 # reduction of license text, suitable for hashing.
105 return(chomp(tolower(gsub('[[:space:]]+',' ',text))))
108 get_license <- function(pkg,license,verbose=FALSE) {
109 license <- gsub('[[:space:]]+$',' ',license)
110 if (length(grep('^file\\s',license))) {
111 notice("License recognised as 'file'-based license.")
112 if (length(grep('^file\\s+LICEN[CS]E$',license))) {
113 file = gsub('file\\s+','',license)
114 path = file.path(pkg$path, file)
115 if (file.exists(path)) {
116 license <- readChar(path,file.info(path)$size)
118 path = file.path(pkg$path, 'inst', file)
119 if (file.exists(path)) {
120 license <- readChar(path,file.info(path)$size)
122 error(paste("Could not locate license file expected at '",
124 file.path(pkg$path, file),"'.\n",sep=""))
128 error("invalid license file specification, expected 'LICENSE' as filename, got: ",license)
135 get_license_hash <- function(pkg,license,verbose=FALSE) {
136 return(digest(get_license(pkg,license,verbose=verbose),algo='sha1',serialize=FALSE))
139 is_acceptable_hash_license <- function(pkg,license,verbose=TRUE,debug=TRUE) {
140 if (debug) cat(paste("is_acceptable_hash_license: pkg$name='",pkg$name,"', license='",license,"'.\n",sep=""))
141 license_sha1 <- get_license_hash(pkg,license,verbose=verbose)
142 if (is.null(license_sha1)) {
143 if (verbose) cat("is_acceptable_hash_license: get_license_hash(pkg,license) returned NULL, returning FALSE.\n")
145 } else if (verbose) {
146 notice(paste("is_acceptable_hash_license, license_sha1 determined: '",license_sha1,"'",sep=""))
148 action = db_license_override_hash(license_sha1)
149 if (is.null(action)) {
150 if (verbose) cat("is_acceptable_hash_license: get_license_override_hash(license_sha1) returned NULL, returning FALSE.\n")
152 } else if (0 == length(action)) {
153 notice("An error occurred, 0==length(action), ignoring package.\n")
155 } else if (is.na(action)) {
156 notice("An error occurred, is.na(action), ignoring package.\n")
160 warn('Wild license',license,'accepted via hash',license_sha1)
166 accept_license <- function(pkg,verbose=TRUE) {
168 if (!('License' %in% names(pkg$description[1,]))) {
169 fail('package has no License: field in description!')
173 if (verbose) { cat("accept_license: pkg:\n"); print(pkg$srcname) }
174 license<-pkg$description[1,'License']
175 if (verbose) { cat(" license:\n"); print(license) }
177 for (l in strsplit(chomp(license),'[[:space:]]*\\|[[:space:]]*')[[1]]) {
178 if (verbose) cat("Investigating: '",l,"'\n",sep="")
179 if (is_acceptable_license(l)) {
182 } else if (is_acceptable_hash_license(pkg,l,verbose=verbose)) {
186 notice(paste("Could not accept license ",l," for package ",pkg,"\n",sep=""))
189 if (is.null(accept)) {
190 fail('No acceptable license:',pkg$description[1,'License'])
192 notice('Auto-accepted license',accept)
194 if (accept == 'Unlimited') {
195 # definition of Unlimited from ``Writing R extensions''
196 accept=paste('Unlimited (no restrictions on distribution or'
197 ,'use other than those imposed by relevant laws)')