branch/split_build/R/license.R

   1 is_acceptable_license <- function(license) {
   2     # determine if license text is acceptable
   3
   4     if (length(grep('^file ',license))) {
   5         # skip file licenses
   6         return(FALSE)
   7     }
   8     license <- license_text_reduce(license)
   9     action = db_license_override_name(license)
  10     if (!is.null(action)) {
  11         return(action)
  12     }
  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!')
  17         return(action)
  18     }
  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!')
  23         return(action)
  24     }
  25     error('Wild license',license,'did not match classic rules; rejecting')
  26     return(F)
  27 }
  28
  29 license_text_reduce <- function(license) {
  30     # these reduction steps are sound for all conformant R license
  31     # specifications.
  32
  33     if (Encoding(license) == "unknown")
  34         Encoding(license) <- "latin1"   # or should it be UTF-8 ?
  35
  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))
  45     return(license)
  46 }
  47
  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.
  51
  52     # uninteresting urls
  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))
  60     # redundant
  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))
  69     return(license)
  70 }
  71
  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))?',''
  75                    ,license)
  76     # remove any extra space introduced
  77     license = chomp(gsub('[[:space:]]+',' ',license))
  78     return(license)
  79 }
  80
  81 license_text_hash_reduce <- function(text) {
  82     # reduction of license text, suitable for hashing.
  83     return(chomp(tolower(gsub('[[:space:]]+',' ',text))))
  84 }
  85
  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")
  96                 close(con)
  97                 license <- license_text_reduce(content)
  98             } else {
  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")
 104                     close(con)
 105                     license <- license_text_reduce(content)
 106                 } else {
 107                     error('said to look at a license file but license file is missing')
 108                 }
 109             }
 110         } else {
 111             error('invalid license file specification',license)
 112             return(NA)
 113         }
 114     }
 115     return(license)
 116 }
 117
 118 get_license_hash <- function(pkg,license) {
 119     return(digest(get_license(pkg,license),algo='sha1',serialize=FALSE))
 120 }
 121
 122 is_acceptable_hash_license <- function(pkg,license) {
 123     license_sha1 <- get_license_hash(pkg,license)
 124     if (is.null(license_sha1)) {
 125         return(FALSE)
 126     }
 127     action = db_license_override_hash(license_sha1)
 128     if (is.null(action)) {
 129         action = FALSE
 130     }
 131     if (action) {
 132         warn('Wild license',license,'accepted via hash',license_sha1)
 133     }
 134     return(action)
 135 }
 136
 137
 138 accept_license <- function(pkg) {
 139     # check the license
 140     if (!('License' %in% names(pkg$description[1,]))) {
 141         fail('package has no License: field in description!')
 142     }
 143     accept=NULL
 144     for (license in strsplit(chomp(pkg$description[1,'License'])
 145                             ,'[[:space:]]*\\|[[:space:]]*')[[1]]) {
 146         if (is_acceptable_license(license)) {
 147             accept=license
 148             break
 149         }
 150         if (is_acceptable_hash_license(pkg,license)) {
 151             accept=license
 152             break
 153         }
 154     }
 155     if (is.null(accept)) {
 156         fail('No acceptable license:',pkg$description[1,'License'])
 157     } else {
 158         notice('Auto-accepted license',accept)
 159     }
 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)')
 164     }
 165     return(accept)
 166 }