1 is_acceptable_license <- function(license) {
2 # determine if license text is acceptable
4 if (length(grep('^file ',license))) {
8 license <- license_text_reduce(license)
9 action = db_license_override_name(license)
10 if (!is.null(action)) {
13 license <- license_text_further_reduce(license)
14 action = db_license_override_name(license)
15 if (!is.null(action)) {
16 warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!')
19 license <- license_text_extreme_reduce(license)
20 action = db_license_override_name(license)
21 if (!is.null(action)) {
22 warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!')
25 error('Wild license',license,'did not match classic rules; rejecting')
29 license_text_reduce <- function(license) {
30 # these reduction steps are sound for all conformant R license
33 if (Encoding(license) == "unknown")
34 Encoding(license) <- "latin1" # or should it be UTF-8 ?
36 ## compress spaces into a single space
37 license = gsub('[[:space:]]+',' ',license)
38 # make all characters lower case
39 license = tolower(license)
40 # don't care about versions of licenses
41 license = chomp(sub('\\( ?[<=>!]+ ?[0-9.-]+ ?\\)',''
42 ,sub('-[0-9.-]+','',license)))
43 # remove any extra space introduced
44 license = chomp(gsub('[[:space:]]+',' ',license))
48 license_text_further_reduce <- function(license) {
49 # these reduction steps are heuristic and may lead to
50 # in correct acceptances, if care is not taken.
53 license = gsub('http://www.gnu.org/[[:alnum:]/._-]*','',license)
54 license = gsub('http://www.x.org/[[:alnum:]/._-]*','',license)
55 license = gsub('http://www.opensource.org/[[:alnum:]/._-]*','',license)
56 # remove all punctuation
57 license = gsub('[[:punct:]]+','',license)
58 # remove any extra space introduced
59 license = chomp(gsub('[[:space:]]+',' ',license))
61 license = gsub('the','',license)
62 license = gsub('see','',license)
63 license = gsub('standard','',license)
64 license = gsub('licen[sc]e','',license)
65 license = gsub('(gnu )?(gpl|general public)','gpl',license)
66 license = gsub('(mozilla )?(mpl|mozilla public)','mpl',license)
67 # remove any extra space introduced
68 license = chomp(gsub('[[:space:]]+',' ',license))
72 license_text_extreme_reduce <- function(license) {
73 # remove everything that may or may not be a version specification
74 license = gsub('(ver?sion|v)? *[0-9.-]+ *(or *(higher|later|newer|greater|above))?',''
76 # remove any extra space introduced
77 license = chomp(gsub('[[:space:]]+',' ',license))
81 license_text_hash_reduce <- function(text) {
82 # reduction of license text, suitable for hashing.
83 return(chomp(tolower(gsub('[[:space:]]+',' ',text))))
86 get_license <- function(pkg,license) {
87 license <- chomp(gsub('[[:space:]]+',' ',license))
88 if (length(grep('^file ',license))) {
89 if (length(grep('^file LICEN[CS]E$',license))) {
90 file = gsub('file ','',license)
91 path = file.path(pkg$path, file)
92 if (file.exists(path)) {
93 #license <- license_text_reduce(readChar(path,file.info(path)$size))
94 con <- file(path, "rb")
95 content <- paste(readLines(con), collapse="\n")
97 license <- license_text_reduce(content)
99 path = file.path(pkg$path, 'inst', file)
100 if (file.exists(path)) {
101 #license <- license_text_reduce(readChar(path,file.info(path)$size))
102 con <- file(path, "rb")
103 content <- paste(readLines(con), collapse="\n")
105 license <- license_text_reduce(content)
107 error('said to look at a license file but license file is missing')
111 error('invalid license file specification',license)
118 get_license_hash <- function(pkg,license) {
119 return(digest(get_license(pkg,license),algo='sha1',serialize=FALSE))
122 is_acceptable_hash_license <- function(pkg,license) {
123 license_sha1 <- get_license_hash(pkg,license)
124 if (is.null(license_sha1)) {
127 action = db_license_override_hash(license_sha1)
128 if (is.null(action)) {
132 warn('Wild license',license,'accepted via hash',license_sha1)
138 accept_license <- function(pkg) {
140 if (!('License' %in% names(pkg$description[1,]))) {
141 fail('package has no License: field in description!')
144 for (license in strsplit(chomp(pkg$description[1,'License'])
145 ,'[[:space:]]*\\|[[:space:]]*')[[1]]) {
146 if (is_acceptable_license(license)) {
150 if (is_acceptable_hash_license(pkg,license)) {
155 if (is.null(accept)) {
156 fail('No acceptable license:',pkg$description[1,'License'])
158 notice('Auto-accepted license',accept)
160 if (accept == 'Unlimited') {
161 # definition of Unlimited from ``Writing R extensions''
162 accept=paste('Unlimited (no restrictions on distribution or'
163 ,'use other than those imposed by relevant laws)')