From 8960d3b57510786d02ee34d7e0f9768be584f164 Mon Sep 17 00:00:00 2001 From: blundellc Date: Sat, 13 Sep 2008 13:17:56 +0000 Subject: [PATCH] licenses+db: delegate license acceptance to the database. add license management interface. ``License: file FOO'' support is nearly done; just need to plug bits together on the acceptance side of things. An SHA1 hash of the license file is stored in the DB for matching. Unsure how effective this will be. Might want to remove all whitespace prior to hashing. needs testing; probably has a few bugs lurking. still need to work out appropriate place for database so that R does not wipe it each time. Perhaps it's time to delve into /var. also a fix to r.dependency.closure --- previously incorrectly uses levels() on the wrong type. git-svn-id: svn://svn.r-forge.r-project.org/svnroot/cran2deb@55 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- pkg/trunk/DESCRIPTION | 4 +-- pkg/trunk/R/db.R | 57 +++++++++++++++++++++++++++++++------------ pkg/trunk/R/license.R | 10 +++----- pkg/trunk/R/rdep.R | 2 +- pkg/trunk/R/util.R | 8 ++++++ pkg/trunk/exec/build | 6 ++--- pkg/trunk/exec/update | 1 + 7 files changed, 58 insertions(+), 30 deletions(-) diff --git a/pkg/trunk/DESCRIPTION b/pkg/trunk/DESCRIPTION index f0fb522..ca1b2fb 100644 --- a/pkg/trunk/DESCRIPTION +++ b/pkg/trunk/DESCRIPTION @@ -4,8 +4,8 @@ Date: 2008-07-14 Title: Convert CRAN packages into Debian packages Author: Charles Blundell , with assistance from Dirk Eddelbuettel <> Maintainer: Charles Blundell -Depends: ctv, utils, RSQLite, DBI -SystemRequirements: rc, pbuilder, debian toolchain, web server, mini-dinstall +Depends: ctv, utils, RSQLite, DBI, digest +SystemRequirements: littler, rc, pbuilder, debian toolchain, web server, mini-dinstall Description: Convert CRAN packages into Debian packages, mostly unassisted, easily subverting the R package system. License: GPL-3 diff --git a/pkg/trunk/R/db.R b/pkg/trunk/R/db.R index 1c53374..c72c8c3 100644 --- a/pkg/trunk/R/db.R +++ b/pkg/trunk/R/db.R @@ -11,11 +11,16 @@ db.start <- function() { } if (!dbExistsTable(con,'license_override')) { dbGetQuery(con,paste('CREATE TABLE license_override (' - ,' name TEXT UNIQUE NOT NULL' - ,',file_sha1 TEXT UNIQUE' + ,' name TEXT PRIMARY KEY NOT NULL' ,',accept INT NOT NULL' ,')')) } + if (!dbExistsTable(con,'license_files')) { + dbGetQuery(con,paste('CREATE TABLE license_files (' + ,' name TEXT NOT NULL' + ,',file_sha1 TEXT PRIMARY KEY NOT NULL' + ,')')) + } return(con) } @@ -53,16 +58,23 @@ db.license.override.name <- function(name) { 'SELECT accept FROM license_override WHERE' ,db.quote(name),'= name')) db.stop(con) - return(results$accept) + if (length(results) == 0) { + return(FALSE) + } + return(as.logical(results$accept)) } -db.add.license.override.name <- function(name,accept) { +db.add.license.override <- function(name,accept) { + message(paste('adding',name,'accept?',accept)) + if (accept != TRUE && accept != FALSE) { + stop('accept must be TRUE or FALSE') + } con <- db.start() results <- dbGetQuery(con,paste( 'INSERT OR REPLACE INTO license_override' ,'(name, accept) VALUES (' ,' ',db.quote(name) - ,',',db.quote(accept) + ,',',as.integer(accept) ,')')) db.stop(con) } @@ -70,21 +82,34 @@ db.add.license.override.name <- function(name,accept) { db.license.override.file <- function(file_sha1) { con <- db.start() results <- dbGetQuery(con,paste( - 'SELECT accept FROM license_override WHERE' - ,db.quote(file_sha1),'= file_sha1')) + 'SELECT name,accept FROM license_override' + ,'INNER JOIN license_files' + ,'ON license_files.name = license_override.name WHERE' + ,db.quote(file_sha1),'= license_files.file_sha1')) db.stop(con) - return(results$accept) + # TODO: change accept from 0,1 into FALSE,TRUE + # TODO: NULL -> FALSE + return(results) } -db.add.license.override.file <- function(name,file_sha1,accept) { +db.license.overrides <- function() { con <- db.start() - results <- dbGetQuery(con,paste( - 'INSERT OR REPLACE INTO license_override' - ,'(name, file_sha1, accept) VALUES (' - ,' ',db.quote(name) - ,',',db.quote(file_sha1) - ,',',db.quote(accept) - ,')')) + overrides <- dbGetQuery(con,paste('SELECT * FROM license_override')) + files <- dbGetQuery(con,paste('SELECT * FROM license_files')) + db.stop(con) + # TODO: change accept from 0,1 into FALSE,TRUE + return(list(overrides=overrides,files=files)) +} + +db.add.license.file <- function(name,file_sha1) { + message(paste('adding file',file_sha1,'for',name)) + con <- db.start() + dbGetQuery(con,paste( + 'INSERT OR REPLACE INTO license_files' + ,'(name, file_sha1) VALUES (' + ,' ',db.quote(name) + ,',',db.quote(file_sha1) + ,')')) db.stop(con) } diff --git a/pkg/trunk/R/license.R b/pkg/trunk/R/license.R index 7112572..06181bf 100644 --- a/pkg/trunk/R/license.R +++ b/pkg/trunk/R/license.R @@ -1,6 +1,3 @@ -debian_ok_licenses=c('GPL','LGPL','AGPL','ARTISTIC' #,'UNLIMITED' - ,'BSD','MIT','APACHE','X11','MPL') - is_acceptable_license <- function(license) { # determine if license is acceptable @@ -11,7 +8,7 @@ is_acceptable_license <- function(license) { # don't care about versions of licenses license = chomp(sub('\\( ?[<=>!]+ ?[0-9.-]+ ?\\)','' ,sub('-[0-9.-]+','',license))) - if (license %in% debian_ok_licenses) { + if (db.license.override.name(license)) { return(T) } # uninteresting urls @@ -31,7 +28,7 @@ is_acceptable_license <- function(license) { license = gsub('(MOZILLA )?(MPL|MOZILLA PUBLIC)','MPL',license) # remove any extra space introduced license = chomp(gsub('[[:space:]]+',' ',license)) - if (license %in% debian_ok_licenses) { + if (db.license.override.name(license)) { message(paste('W: Accepted wild license as',license,'. FIX THE PACKAGE!')) return(T) } @@ -40,11 +37,10 @@ is_acceptable_license <- function(license) { ,license) # remove any extra space introduced license = chomp(gsub('[[:space:]]+',' ',license)) - if (license %in% debian_ok_licenses) { + if (db.license.override.name(license)) { message(paste('W: Accepted wild license as',license,'. FIX THE PACKAGE!')) return(T) } - # TODO: put debian_ok_licenses in DB # TODO: file {LICENSE,LICENCE} (+ maybe COPYING?) message(paste('E: Wild license',license,'did not match')) return(F) diff --git a/pkg/trunk/R/rdep.R b/pkg/trunk/R/rdep.R index 1cc3054..305e43f 100644 --- a/pkg/trunk/R/rdep.R +++ b/pkg/trunk/R/rdep.R @@ -126,7 +126,7 @@ r.dependency.closure <- function(fringe, forward_arcs=T) { if (is.data.frame(fringe)) { fringe <- as.list(fringe$name) } - fun = function(x) levels(r.dependencies.of(name=x)$name) + fun = function(x) r.dependencies.of(name=x)$name if (!forward_arcs) { fun = r.requiring } diff --git a/pkg/trunk/R/util.R b/pkg/trunk/R/util.R index 35f6413..f4a8ddc 100644 --- a/pkg/trunk/R/util.R +++ b/pkg/trunk/R/util.R @@ -15,3 +15,11 @@ host.arch <- function() { system('dpkg-architecture -qDEB_HOST_ARCH',intern=T) } +err <- function(text) { + message(paste('E:',text)) + exit() +} + +exit <- function() { + q(save='no') +} diff --git a/pkg/trunk/exec/build b/pkg/trunk/exec/build index 0482896..63ccf3b 100755 --- a/pkg/trunk/exec/build +++ b/pkg/trunk/exec/build @@ -73,8 +73,7 @@ if (exists('argv')) { # check for littler break } if (i == argc) { - message('E: missing argument') - q(save='no') + err('missing argument') } if (argv[i] == '-D') { extra_deps$deb = c(extra_deps$deb,strsplit(chomp(argv[i+1]),',')[[1]]) @@ -85,8 +84,7 @@ if (exists('argv')) { # check for littler } } if (argc == 0) { - message('E: usage: cran2deb [-D extra_dep1,extra_dep2,...] package package ...') - q(save='no') + err('usage: cran2deb [-D extra_dep1,extra_dep2,...] package package ...') } build_order <- r.dependency.closure(c(extra_deps$r,argv)) message(paste('N: build order',paste(build_order,collapse=', '))) diff --git a/pkg/trunk/exec/update b/pkg/trunk/exec/update index 598597c..59fa41a 100755 --- a/pkg/trunk/exec/update +++ b/pkg/trunk/exec/update @@ -18,3 +18,4 @@ if ([ -e /var/cache/pbuilder/base-cran2deb.tgz ]) { } sudo pbuilder $mode --override-config --configfile $root/etc/pbuilderrc $root/exec/update_cache $root +$root/exec/license <$root/data/populate_licenses -- 2.39.5