From 5101cce1568b46d042316f32c8216e956f76ff65 Mon Sep 17 00:00:00 2001 From: blundellc Date: Sat, 13 Sep 2008 13:25:59 +0000 Subject: [PATCH] gsoc_final git-svn-id: svn://svn.r-forge.r-project.org/svnroot/cran2deb@119 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- tags/gsoc_final/DESCRIPTION | 11 + tags/gsoc_final/R/build.R | 140 +++++++ tags/gsoc_final/R/db.R | 374 ++++++++++++++++++ tags/gsoc_final/R/debcontrol.R | 158 ++++++++ tags/gsoc_final/R/debiannaming.R | 52 +++ tags/gsoc_final/R/debianpkg.R | 126 ++++++ tags/gsoc_final/R/getrpkg.R | 157 ++++++++ tags/gsoc_final/R/license.R | 147 +++++++ tags/gsoc_final/R/log.R | 65 +++ tags/gsoc_final/R/rdep.R | 155 ++++++++ tags/gsoc_final/R/util.R | 25 ++ tags/gsoc_final/R/version.R | 92 +++++ tags/gsoc_final/R/zzz.R | 25 ++ tags/gsoc_final/README | 1 + tags/gsoc_final/configure | 12 + tags/gsoc_final/data/populate_depend_aliases | 53 +++ tags/gsoc_final/data/populate_forcedep | 7 + tags/gsoc_final/data/populate_licenses | 89 +++++ tags/gsoc_final/data/populate_sysreq | 34 ++ tags/gsoc_final/data/quit | 1 + tags/gsoc_final/exec/autobuild | 15 + tags/gsoc_final/exec/build | 43 ++ tags/gsoc_final/exec/build_ctv | 14 + tags/gsoc_final/exec/build_some | 36 ++ tags/gsoc_final/exec/copy_find | 33 ++ tags/gsoc_final/exec/cran2deb | 9 + tags/gsoc_final/exec/cran_pkgs | 28 ++ tags/gsoc_final/exec/depend | 82 ++++ tags/gsoc_final/exec/diagnose | 72 ++++ tags/gsoc_final/exec/diagnose_ctv | 2 + tags/gsoc_final/exec/get_base_pkgs | 4 + tags/gsoc_final/exec/help | 6 + tags/gsoc_final/exec/license | 126 ++++++ tags/gsoc_final/exec/root | 2 + tags/gsoc_final/exec/update | 41 ++ tags/gsoc_final/exec/update_cache | 30 ++ tags/gsoc_final/inst/doc/README | 47 +++ tags/gsoc_final/inst/etc/dput.cf.in | 8 + tags/gsoc_final/inst/etc/hook/A80rjava | 4 + tags/gsoc_final/inst/etc/hook/B90lintian | 6 + tags/gsoc_final/inst/etc/hook/B91dpkg-i | 28 ++ tags/gsoc_final/inst/etc/hook/B92test-pkg | 52 +++ tags/gsoc_final/inst/etc/hook/D70aptupdate | 1 + .../gsoc_final/inst/etc/mini-dinstall.conf.in | 12 + tags/gsoc_final/inst/etc/pbuilderrc.in | 12 + 45 files changed, 2437 insertions(+) create mode 100644 tags/gsoc_final/DESCRIPTION create mode 100644 tags/gsoc_final/R/build.R create mode 100644 tags/gsoc_final/R/db.R create mode 100644 tags/gsoc_final/R/debcontrol.R create mode 100644 tags/gsoc_final/R/debiannaming.R create mode 100644 tags/gsoc_final/R/debianpkg.R create mode 100644 tags/gsoc_final/R/getrpkg.R create mode 100644 tags/gsoc_final/R/license.R create mode 100644 tags/gsoc_final/R/log.R create mode 100644 tags/gsoc_final/R/rdep.R create mode 100644 tags/gsoc_final/R/util.R create mode 100644 tags/gsoc_final/R/version.R create mode 100644 tags/gsoc_final/R/zzz.R create mode 120000 tags/gsoc_final/README create mode 100755 tags/gsoc_final/configure create mode 100644 tags/gsoc_final/data/populate_depend_aliases create mode 100644 tags/gsoc_final/data/populate_forcedep create mode 100644 tags/gsoc_final/data/populate_licenses create mode 100644 tags/gsoc_final/data/populate_sysreq create mode 100644 tags/gsoc_final/data/quit create mode 100755 tags/gsoc_final/exec/autobuild create mode 100755 tags/gsoc_final/exec/build create mode 100755 tags/gsoc_final/exec/build_ctv create mode 100755 tags/gsoc_final/exec/build_some create mode 100755 tags/gsoc_final/exec/copy_find create mode 100755 tags/gsoc_final/exec/cran2deb create mode 100755 tags/gsoc_final/exec/cran_pkgs create mode 100755 tags/gsoc_final/exec/depend create mode 100755 tags/gsoc_final/exec/diagnose create mode 100755 tags/gsoc_final/exec/diagnose_ctv create mode 100755 tags/gsoc_final/exec/get_base_pkgs create mode 100755 tags/gsoc_final/exec/help create mode 100755 tags/gsoc_final/exec/license create mode 100755 tags/gsoc_final/exec/root create mode 100755 tags/gsoc_final/exec/update create mode 100755 tags/gsoc_final/exec/update_cache create mode 100644 tags/gsoc_final/inst/doc/README create mode 100644 tags/gsoc_final/inst/etc/dput.cf.in create mode 100755 tags/gsoc_final/inst/etc/hook/A80rjava create mode 100755 tags/gsoc_final/inst/etc/hook/B90lintian create mode 100755 tags/gsoc_final/inst/etc/hook/B91dpkg-i create mode 100755 tags/gsoc_final/inst/etc/hook/B92test-pkg create mode 100755 tags/gsoc_final/inst/etc/hook/D70aptupdate create mode 100644 tags/gsoc_final/inst/etc/mini-dinstall.conf.in create mode 100644 tags/gsoc_final/inst/etc/pbuilderrc.in diff --git a/tags/gsoc_final/DESCRIPTION b/tags/gsoc_final/DESCRIPTION new file mode 100644 index 0000000..d591695 --- /dev/null +++ b/tags/gsoc_final/DESCRIPTION @@ -0,0 +1,11 @@ +Package: cran2deb +Version: 0.0 +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, digest +SystemRequirements: littler, rc, pbuilder, debian toolchain, web server, mini-dinstall, curl +Description: Convert CRAN packages into Debian packages, mostly unassisted, easily + subverting the R package system. +License: GPL-3 diff --git a/tags/gsoc_final/R/build.R b/tags/gsoc_final/R/build.R new file mode 100644 index 0000000..316258b --- /dev/null +++ b/tags/gsoc_final/R/build.R @@ -0,0 +1,140 @@ + +build <- function(name,extra_deps,force=F) { + # can't, and hence don't need to, build base packages + if (name %in% base_pkgs) { + return(T) + } + log_clear() + dir <- setup() + + # obtain the Debian version-to-be + version <- try(new_build_version(name)) + if (inherits(version,'try-error')) { + error('failed to build',name) + return(NULL) + } + + result <- try((function() { + if (!force && !needs_build(name,version)) { + notice('skipping build of',name) + return(NULL) + } + + pkg <- prepare_new_debian(prepare_pkg(dir,name),extra_deps) + if (pkg$debversion != version) { + fail('expected Debian version',version,'not equal to actual version',pkg$debversion) + } + # delete the current archive (XXX: assumes mini-dinstall) + for (subdir in c('mini-dinstall','unstable')) { + path = file.path(dinstall_archive,subdir) + if (file.exists(path)) { + unlink(path,recursive=T) + } + } + + # delete notes of upload + file.remove(Sys.glob(file.path(pbuilder_results,'*.upload'))) + + # make mini-dinstall generate the skeleton of the archive + ret = log_system('umask 022;mini-dinstall --batch -c',dinstall_config) + if (ret != 0) { + fail('failed to create archive') + } + + # pull in all the R dependencies + notice('dependencies:',paste(pkg$depends$r,collapse=', ')) + for (dep in pkg$depends$r) { + if (pkgname_as_debian(dep) %in% debian_pkgs) { + notice('using Debian package of',dep) + next + } + # otherwise, convert to source package name + srcdep = pkgname_as_debian(dep,binary=F) + + notice('uploading',srcdep) + ret = log_system('umask 022;dput','-c',shQuote(dput_config),'local' + ,changesfile(srcdep)) + if (ret != 0) { + fail('upload of dependency failed! maybe you did not build it first?') + } + } + build_debian(pkg) + + # upload the package + ret = log_system('umask 022;dput','-c',shQuote(dput_config),'local' + ,changesfile(pkg$srcname,pkg$debversion)) + if (ret != 0) { + fail('upload failed!') + } + + return(pkg$debversion) + })()) + cleanup(dir) + if (is.null(result)) { + # nothing was done so escape asap. + return(result) + } + + # otherwise record progress + failed = inherits(result,'try-error') + if (failed) { + error('failure of',name,'means these packages will fail:' + ,paste(r_dependency_closure(name,forward_arcs=F),collapse=', ')) + } + db_record_build(name, version, log_retrieve(), !failed) + return(!failed) +} + +needs_build <- function(name,version) { + # see if the last build was successful + build <- db_latest_build(name) + if (!is.null(build) && build$success) { + # then something must have changed for us to attempt this + # build + if (build$r_version == version_upstream(version) && + build$deb_epoch == version_epoch(version) && + build$db_version == db_get_version()) { + return(F) + } + } else { + # always rebuild on failure or no record + return(T) + } + # see if it has already been built + srcname <- pkgname_as_debian(name,binary=F) + debname <- pkgname_as_debian(name,binary=T) + if (file.exists(changesfile(srcname, version))) { + notice('already built',srcname,'version',version) + return(F) + } + + # XXX: what about building newer versions of Debian packages? + if (debname %in% debian_pkgs) { + notice(srcname,' exists in Debian (perhaps a different version)') + return(F) + } + + rm(debname,srcname) + return(T) +} + +build_debian <- function(pkg) { + wd <- getwd() + setwd(pkg$path) + notice('building Debian package' + ,pkg$debname + ,paste('(',pkg$debversion,')',sep='') + ,'...') + + cmd = paste('pdebuild --configfile',shQuote(pbuilder_config)) + if (version_revision(pkg$debversion) > 2) { + cmd = paste(cmd,'--debbuildopts','-sd') + notice('build should exclude original source') + } + ret = log_system(cmd) + setwd(wd) + if (ret != 0) { + fail('Failed to build package.') + } +} + diff --git a/tags/gsoc_final/R/db.R b/tags/gsoc_final/R/db.R new file mode 100644 index 0000000..f6a4c07 --- /dev/null +++ b/tags/gsoc_final/R/db.R @@ -0,0 +1,374 @@ + +db_start <- function() { + drv <- dbDriver('SQLite') + con <- dbConnect(drv, dbname=file.path(cache_root,'cran2deb.db')) + if (!dbExistsTable(con,'sysreq_override')) { + dbGetQuery(con,paste('CREATE TABLE sysreq_override (' + ,' depend_alias TEXT NOT NULL' + ,',r_pattern TEXT PRIMARY KEY NOT NULL' + ,')')) + } + if (!dbExistsTable(con,'debian_dependency')) { + dbGetQuery(con,paste('CREATE TABLE debian_dependency (' + ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL' + ,',alias TEXT NOT NULL' + ,',build INTEGER NOT NULL' + ,',debian_pkg TEXT NOT NULL' + ,',UNIQUE (alias,build,debian_pkg)' + ,')')) + } + if (!dbExistsTable(con,'forced_depends')) { + dbGetQuery(con,paste('CREATE TABLE forced_depends (' + ,' r_name TEXT NOT NULL' + ,',depend_alias TEXT NOT NULL' + ,',PRIMARY KEY (r_name,depend_alias)' + ,')')) + } + if (!dbExistsTable(con,'license_override')) { + dbGetQuery(con,paste('CREATE TABLE license_override (' + ,' name TEXT PRIMARY KEY NOT NULL' + ,',accept INT NOT NULL' + ,')')) + } + if (!dbExistsTable(con,'license_hashes')) { + dbGetQuery(con,paste('CREATE TABLE license_hashes (' + ,' name TEXT NOT NULL' + ,',sha1 TEXT PRIMARY KEY NOT NULL' + ,')')) + } + if (!dbExistsTable(con,'database_versions')) { + dbGetQuery(con,paste('CREATE TABLE database_versions (' + ,' version INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL' + ,',version_date INTEGER NOT NULL' + ,',base_epoch INTEGER NOT NULL' + ,')')) + db_add_version(con,1,0) + } + if (!dbExistsTable(con,'packages')) { + dbGetQuery(con,paste('CREATE TABLE packages (' + ,' package TEXT PRIMARY KEY NOT NULL' + ,',latest_r_version TEXT' + ,')')) + } + if (!dbExistsTable(con,'builds')) { + dbGetQuery(con,paste('CREATE TABLE builds (' + ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL' + ,',package TEXT NOT NULL' + ,',r_version TEXT NOT NULL' + ,',deb_epoch INTEGER NOT NULL' + ,',deb_revision INTEGER NOT NULL' + ,',db_version INTEGER NOT NULL' + ,',date_stamp TEXT NOT NULL' + ,',git_revision TEXT NOT NULL' + ,',success INTEGER NOT NULL' + ,',log TEXT' + ,',UNIQUE(package,r_version,deb_epoch,deb_revision,db_version)' + ,')')) + } + return(con) +} + +db_stop <- function(con,bump=F) { + if (bump) { + db_bump(con) + } + dbDisconnect(con) +} + +db_quote <- function(text) { + return(paste('\'', gsub('([\'"])','\\1\\1',text),'\'',sep='')) +} + +db_now <- function() { + return(as.integer(gsub('-','',Sys.Date()))) +} + +db_cur_version <- function(con) { + return(as.integer(dbGetQuery(con, 'SELECT max(version) FROM database_versions')[[1]])) +} + +db_base_epoch <- function(con) { + return(as.integer(dbGetQuery(con, + paste('SELECT max(base_epoch) FROM database_versions' + ,'WHERE version IN (SELECT max(version) FROM database_versions)'))[[1]])) +} + +db_get_base_epoch <- function() { + con <- db_start() + v <- db_base_epoch(con) + db_stop(con) + return(v) +} + +db_get_version <- function() { + con <- db_start() + v <- db_cur_version(con) + db_stop(con) + return(v) +} + +db_add_version <- function(con, version, epoch) { + dbGetQuery(con,paste('INSERT INTO database_versions (version,version_date,base_epoch)' + ,'VALUES (',as.integer(version),',',db_now(),',',as.integer(epoch),')')) +} + +db_bump <- function(con) { + db_add_version(con,db_cur_version(con)+1, db_base_epoch(con)) +} + +db_bump_epoch <- function(con) { + db_add_version(con,db_cur_version(con)+1, db_base_epoch(con)+1) +} + +db_sysreq_override <- function(sysreq_text) { + con <- db_start() + results <- dbGetQuery(con,paste( + 'SELECT DISTINCT depend_alias FROM sysreq_override WHERE' + ,db_quote(tolower(sysreq_text)),'LIKE r_pattern')) + db_stop(con) + if (length(results) == 0) { + return(NULL) + } + return(results$depend_alias) +} + +db_add_sysreq_override <- function(pattern,depend_alias) { + con <- db_start() + results <- dbGetQuery(con,paste( + 'INSERT OR REPLACE INTO sysreq_override' + ,'(depend_alias, r_pattern) VALUES (' + ,' ',db_quote(tolower(depend_alias)) + ,',',db_quote(tolower(pattern)) + ,')')) + db_stop(con,TRUE) +} + +db_sysreq_overrides <- function() { + con <- db_start() + overrides <- dbGetQuery(con,paste('SELECT * FROM sysreq_override')) + db_stop(con) + return(overrides) +} + +db_get_depends <- function(depend_alias,build=F) { + con <- db_start() + results <- dbGetQuery(con,paste( + 'SELECT DISTINCT debian_pkg FROM debian_dependency WHERE' + ,db_quote(tolower(depend_alias)),'= alias' + ,'AND',as.integer(build),'= build')) + db_stop(con) + return(results$debian_pkg) +} + +db_add_depends <- function(depend_alias,debian_pkg,build=F) { + con <- db_start() + results <- dbGetQuery(con,paste( + 'INSERT OR REPLACE INTO debian_dependency' + ,'(alias, build, debian_pkg) VALUES (' + ,' ',db_quote(tolower(depend_alias)) + ,',',as.integer(build) + ,',',db_quote(tolower(debian_pkg)) + ,')')) + db_stop(con,TRUE) +} + +db_depends <- function() { + con <- db_start() + depends <- dbGetQuery(con,paste('SELECT * FROM debian_dependency')) + db_stop(con) + return(depends) +} + +db_get_forced_depends <- function(r_name) { + con <- db_start() + forced_depends <- dbGetQuery(con, + paste('SELECT depend_alias FROM forced_depends WHERE' + ,db_quote(r_name),'= r_name')) + db_stop(con) + return(forced_depends$depend_alias) +} + +db_add_forced_depends <- function(r_name, depend_alias) { + if (!length(db_get_depends(depend_alias,build=F)) && + !length(db_get_depends(depend_alias,build=T))) { + fail('Debian dependency alias',depend_alias,'is not know,' + ,'yet trying to force a dependency on it?') + } + con <- db_start() + dbGetQuery(con, + paste('INSERT OR REPLACE INTO forced_depends (r_name, depend_alias)' + ,'VALUES (',db_quote(r_name),',',db_quote(depend_alias),')')) + db_stop(con,TRUE) +} + +db_forced_depends <- function() { + con <- db_start() + depends <- dbGetQuery(con,paste('SELECT * FROM forced_depends')) + db_stop(con) + return(depends) +} + +db_license_override_name <- function(name) { + con <- db_start() + results <- dbGetQuery(con,paste( + 'SELECT DISTINCT accept FROM license_override WHERE' + ,db_quote(tolower(name)),'= name')) + db_stop(con) + if (length(results) == 0) { + return(NULL) + } + return(as.logical(results$accept)) +} + +db_add_license_override <- function(name,accept) { + notice('adding',name,'accept?',accept) + if (accept != TRUE && accept != FALSE) { + fail('accept must be TRUE or FALSE') + } + con <- db_start() + results <- dbGetQuery(con,paste( + 'INSERT OR REPLACE INTO license_override' + ,'(name, accept) VALUES (' + ,' ',db_quote(tolower(name)) + ,',',as.integer(accept) + ,')')) + db_stop(con,TRUE) +} + +db_license_override_hash <- function(license_sha1) { + con <- db_start() + results <- dbGetQuery(con,paste( + 'SELECT DISTINCT accept FROM license_override' + ,'INNER JOIN license_hashes' + ,'ON license_hashes.name = license_override.name WHERE' + ,db_quote(tolower(license_sha1)),'= license_hashes.sha1')) + db_stop(con) + if (length(results) == 0) { + return(NULL) + } + return(as.logical(results$accept)) +} + +db_license_overrides <- function() { + con <- db_start() + overrides <- dbGetQuery(con,paste('SELECT * FROM license_override')) + hashes <- dbGetQuery(con,paste('SELECT * FROM license_hashes')) + db_stop(con) + return(list(overrides=overrides,hashes=hashes)) +} + +db_add_license_hash <- function(name,license_sha1) { + if (is.null(db_license_override_name(name))) { + fail('license',name,'is not know, yet trying to add a hash for it?') + } + notice('adding hash',license_sha1,'for',name) + con <- db_start() + dbGetQuery(con,paste( + 'INSERT OR REPLACE INTO license_hashes' + ,'(name, sha1) VALUES (' + ,' ',db_quote(tolower(name)) + ,',',db_quote(tolower(license_sha1)) + ,')')) + db_stop(con,TRUE) +} + + +db_update_package_versions <- function() { + con <- db_start() + for (package in available[,'Package']) { + dbGetQuery(con, paste('INSERT OR REPLACE INTO packages (package,latest_r_version)' + ,'VALUES (',db_quote(package) + ,',',db_quote(available[package,'Version']),')')) + } + db_stop(con) +} + +db_record_build <- function(package, deb_version, log, success=F) { + con <- db_start() + dbGetQuery(con,paste('INSERT OR REPLACE INTO builds' + ,'(package,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,git_revision,log)' + ,'VALUES' + ,'(',db_quote(package) + ,',',db_quote(version_upstream(deb_version)) + ,',',db_quote(version_epoch(deb_version)) + ,',',db_quote(version_revision(deb_version)) + ,',',db_cur_version(con) + ,',',as.integer(success) + ,',',db_quote(format(Sys.time(),'%a, %d %b %Y %H:%M:%S %z')) + ,',',db_quote(git_revision) + ,',',db_quote(paste(log, collapse='\n')) + ,')')) + db_stop(con) +} + +db_builds <- function(pkgname) { + # returns all successful builds + con <- db_start() + build <- dbGetQuery(con, paste('SELECT * FROM builds' + ,'WHERE success = 1' + ,'AND package =',db_quote(pkgname))) + db_stop(con) + if (length(build) == 0) { + return(NULL) + } + build$success <- as.logical(build$success) + return(build) +} + +db_latest_build <- function(pkgname) { + con <- db_start() + build <- dbGetQuery(con, paste('SELECT * FROM builds' + ,'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds' + , 'GROUP BY package) AS last' + ,'WHERE id = max_id' + ,'AND builds.package =',db_quote(pkgname))) + db_stop(con) + if (length(build) == 0) { + return(NULL) + } + build$success <- as.logical(build$success) + return(build) +} + +db_latest_build_version <- function(pkgname) { + build <- db_latest_build(pkgname) + if (is.null(build)) { + return(NULL) + } + return(version_new(build$r_version, build$deb_revision, build$deb_epoch)) +} + +db_latest_build_status <- function(pkgname) { + build <- db_latest_build(pkgname) + if (is.null(build)) { + return(NULL) + } + return(list(build$success,build$log)) +} + +db_outdated_packages <- function() { + con <- db_start() + packages <- dbGetQuery(con,paste('SELECT packages.package FROM packages' + ,'LEFT OUTER JOIN (' + # extract the latest attempt at building each package + , 'SELECT * FROM builds' + , 'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds' + , 'GROUP BY package) AS last' + , 'WHERE id = max_id) AS build' + ,'ON build.package = packages.package' + # outdated iff: + # - there is no latest build + ,'WHERE build.package IS NULL' + # - the database has changed since last build + ,'OR build.db_version < (SELECT max(version) FROM database_versions)' + # - the debian epoch has been bumped up + ,'OR build.deb_epoch < (SELECT max(base_epoch) FROM database_versions' + , 'WHERE version IN (' + , 'SELECT max(version) FROM database_versions))' + # - the latest build is not of the latest R version + ,'OR build.r_version != packages.latest_r_version' + ))$package + db_stop(con) + return(packages) +} + diff --git a/tags/gsoc_final/R/debcontrol.R b/tags/gsoc_final/R/debcontrol.R new file mode 100644 index 0000000..c610ce2 --- /dev/null +++ b/tags/gsoc_final/R/debcontrol.R @@ -0,0 +1,158 @@ +get_dependencies <- function(pkg,extra_deps) { + # determine dependencies + dependencies <- r_dependencies_of(description=pkg$description) + depends <- list() + # these are used for generating the Depends fields + as_deb <- function(r,build) { + return(pkgname_as_debian(paste(dependencies[r,]$name) + ,version=dependencies[r,]$version + ,repopref=pkg$repo + ,build=build)) + } + depends$bin <- lapply(rownames(dependencies), as_deb, build=F) + depends$build <- lapply(rownames(dependencies), as_deb, build=T) + # add the command line dependencies + depends$bin = c(extra_deps$deb,depends$bin) + depends$build = c(extra_deps$deb,depends$build) + # add the system requirements + if ('SystemRequirements' %in% colnames(pkg$description)) { + sysreq <- sysreqs_as_debian(pkg$description[1,'SystemRequirements']) + depends$bin = c(sysreq$bin,depends$bin) + depends$build = c(sysreq$build,depends$build) + } + + forced <- forced_deps_as_debian(pkg$name) + if (length(forced)) { + depends$bin = c(forced$bin,depends$bin) + depends$build = c(forced$build,depends$build) + } + + # make sure we depend upon R in some way... + if (!length(grep('^r-base',depends$build))) { + depends$build = c(depends$build,pkgname_as_debian('R',version='>= 2.7.0',build=T)) + depends$bin = c(depends$bin, pkgname_as_debian('R',version='>= 2.7.0',build=F)) + } + # also include stuff to allow tcltk to build (suggested by Dirk) + depends$build = c(depends$build,'xvfb','xauth','xfonts-base') + + # make all bin dependencies build dependencies. + depends$build = c(depends$build, depends$bin) + + # remove duplicates + depends <- lapply(depends,unique) + + # append the Debian dependencies + depends$build=c(depends$build,'debhelper (>> 4.1.0)','cdbs') + if (pkg$archdep) { + depends$bin=c(depends$bin,'${shlibs:Depends}') + } + + # the names of dependent source packages (to find the .changes file to + # upload via dput). these can be found recursively. + depends$r = r_dependency_closure(dependencies) + # append command line dependencies + depends$r = c(extra_deps$r, depends$r) + return(depends) +} + +sysreqs_as_debian <- function(sysreq_text) { + # form of this field is unspecified (ugh) but most people seem to stick + # with this + aliases <- c() + sysreq_text <- gsub('[[:space:]]and[[:space:]]',' , ',tolower(sysreq_text)) + for (sysreq in strsplit(sysreq_text,'[[:space:]]*,[[:space:]]*')[[1]]) { + startreq = sysreq + # constant case + sysreq = tolower(sysreq) + # drop version information/comments for now + sysreq = gsub('[[][^])]*[]]','',sysreq) + sysreq = gsub('\\([^)]*\\)','',sysreq) + sysreq = gsub('[[][^])]*[]]','',sysreq) + sysreq = gsub('version','',sysreq) + sysreq = gsub('from','',sysreq) + sysreq = gsub('[<>=]*[[:space:]]*[[:digit:]]+[[:digit:].+:~-]*','',sysreq) + # byebye URLs + sysreq = gsub('(ht|f)tps?://[[:alnum:]!?*"\'(),%$_@.&+/=-]*','',sysreq) + # squish out space + sysreq = chomp(gsub('[[:space:]]+',' ',sysreq)) + alias <- db_sysreq_override(sysreq) + if (is.null(alias)) { + error('do not know what to do with SystemRequirement:',sysreq) + error('original SystemRequirement:',startreq) + fail('unmet system requirement') + } + notice('mapped SystemRequirement',startreq,'onto',alias,'via',sysreq) + aliases = c(aliases,alias) + } + return(map_aliases_to_debian(aliases)) +} + +forced_deps_as_debian <- function(r_name) { + aliases <- db_get_forced_depends(r_name) + return(map_aliases_to_debian(aliases)) +} + +map_aliases_to_debian <- function(aliases) { + if (!length(aliases)) { + return(aliases) + } + debs <- list() + debs$bin = unlist(sapply(aliases, db_get_depends)) + debs$build = unlist(sapply(aliases, db_get_depends, build=T)) + debs$bin = debs$bin[debs$bin != 'build-essential'] + debs$build = debs$build[debs$build != 'build-essential'] + return(debs) +} + +generate_control <- function(pkg) { + # construct control file + control = data.frame() + control[1,'Source'] = pkg$srcname + control[1,'Section'] = 'math' + control[1,'Priority'] = 'optional' + control[1,'Maintainer'] = maintainer + control[1,'Build-Depends'] = paste(pkg$depends$build,collapse=', ') + control[1,'Standards-Version'] = '3.8.0' + + control[2,'Package'] = pkg$debname + control[2,'Architecture'] = 'all' + if (pkg$archdep) { + control[2,'Architecture'] = 'any' + } + control[2,'Depends'] = paste(pkg$depends$bin,collapse=', ') + +# # bundles provide virtual packages of their contents +# # unnecessary for now; cran2deb converts R bundles itself +# if (pkg$is_bundle) { +# control[2,'Provides'] = paste( +# lapply(r_bundle_contains(pkg$name) +# ,function(name) return(pkgname_as_debian(paste(name) +# ,repopref=pkg$repo))) +# ,collapse=', ') +# } + + # generate the description + descr = 'GNU R package "' + if ('Title' %in% colnames(pkg$description)) { + descr = paste(descr,pkg$description[1,'Title'],sep='') + } else { + descr = paste(descr,pkg$name,sep='') + } + if (pkg$is_bundle) { + long_descr <- pkg$description[1,'BundleDescription'] + } else { + long_descr <- pkg$description[1,'Description'] + } + # using \n\n.\n\n is not very nice, but is necessary to make sure + # the longer description does not begin on the synopsis line --- R's + # write.dcf does not appear to have a nicer way of doing this. + descr = paste(descr,'"\n\n', long_descr, sep='') + if ('URL' %in% colnames(pkg$description)) { + descr = paste(descr,'\n\nURL: ',pkg$description[1,'URL'],sep='') + } + control[2,'Description'] = descr + + # Debian policy says 72 char width; indent minimally + write.dcf(control,file=pkg$debfile('control.in'),indent=1,width=72) +} + diff --git a/tags/gsoc_final/R/debiannaming.R b/tags/gsoc_final/R/debiannaming.R new file mode 100644 index 0000000..83c0ab5 --- /dev/null +++ b/tags/gsoc_final/R/debiannaming.R @@ -0,0 +1,52 @@ +repourl_as_debian <- function(url) { + # map the url to a repository onto its name in debian package naming + if (length(grep('cran',url))) { + return('cran') + } + if (length(grep('bioc',url))) { + return('bioc') + } + fail('unknown repository',url) +} + +pkgname_as_debian <- function(name,repopref=NULL,version=NULL,binary=T,build=F) { + # generate the debian package name corresponding to the R package name + if (name %in% base_pkgs) { + name = 'R' + } + if (name == 'R') { + # R is special. + if (binary) { + if (build) { + debname='r-base-dev' + } else { + debname='r-base-core' + } + } else { + debname='R' + } + } else { + # XXX: data.frame rownames are unique, so always override repopref for + # now. + if (!(name %in% rownames(available))) { + bundle <- r_bundle_of(name) + if (!is.null(bundle)) { + name <- bundle + } + } + debname = tolower(name) + if (binary) { + if (name %in% rownames(available)) { + repopref <- tolower(repourl_as_debian(available[name,'Repository'])) + } else if (is.null(repopref)) { + repopref <- 'unknown' + } + debname = paste('r',repopref,debname,sep='-') + } + } + if (!is.null(version) && length(version) > 1) { + debname = paste(debname,' (',version,')',sep='') + } + return(debname) +} + diff --git a/tags/gsoc_final/R/debianpkg.R b/tags/gsoc_final/R/debianpkg.R new file mode 100644 index 0000000..017dbfa --- /dev/null +++ b/tags/gsoc_final/R/debianpkg.R @@ -0,0 +1,126 @@ +append_build_from_pkg <- function(pkg, builds) { + pkg_build <- data.frame(id = -1 # never used + ,package = pkg$name + ,r_version = version_upstream(pkg$debversion) + ,deb_epoch = version_epoch(pkg$debversion) + ,deb_revision = version_revision(pkg$debversion) + ,db_version = db_get_version() + ,date_stamp = pkg$date_stamp + ,git_revision = git_revision + ,success = 1 # never used + ,log = '' # never used + ) + return(cbind(data.frame(srcname=pkg$srcname), rbind(builds, pkg_build))) +} + +generate_changelog <- function(pkg) { + # TODO: ``Writing R extensions'' mentions that a package may also have + # {NEWS,ChangeLog} files. + builds <- append_build_from_pkg(pkg, db_builds(pkg$name)) + sapply(rev(rownames(builds)), function(b, changelog) generate_changelog_entry(builds[b,], changelog), pkg$debfile('changelog.in')) +} + +generate_changelog_entry <- function(build, changelog) { + # TODO: should say 'New upstream release' when necessary + debversion <- version_new(build$r_version, build$deb_revision, build$deb_epoch) + cat(paste(paste(build$srcname,' (',debversion,') unstable; urgency=low',sep='') + ,'' ,paste(' * cran2deb ',build$git_revision + ,' with DB version ',as.integer(build$db_version),'.',sep='') + ,'',paste(' --',maintainer,'',build$date_stamp) + ,'','','',sep='\n'),file=changelog, append=TRUE) +} + +generate_rules <- function(pkg) { + cat(paste('#!/usr/bin/make -f' + ,paste('debRreposname :=',pkg$repo) + ,'include /usr/share/R/debian/r-cran.mk' + ,'',sep='\n') + ,file=pkg$debfile('rules')) + Sys.chmod(pkg$debfile('rules'),'0700') +} + +generate_copyright <- function(pkg) { + # generate_copyright file; we trust DESCRIPTION + writeLines(strwrap( + paste('This Debian package of the GNU R package',pkg$name + ,'was generated automatically using cran2deb by' + ,paste(maintainer,'.',sep='') + ,'' + ,'The original GNU R package is Copyright (C) ' + # TODO: copyright start date, true copyright date + ,format(Sys.time(),'%Y') + ,pkg$description[1,'Author'] + ,'and possibly others.' + ,'' + ,'The original GNU R package is maintained by' + ,pkg$description[1,'Maintainer'],'and was obtained from:' + ,'' + ,pkg$repoURL + ,'' + ,'' + ,'The GNU R package DESCRIPTION offers a' + ,'Copyright licenses under the terms of the license:' + ,pkg$license,'. On a Debian GNU/Linux system, common' + ,'licenses are included in the directory' + ,'/usr/share/common-licenses/.' + ,'' + ,'The DESCRIPTION file for the original GNU R package ' + ,'can be found in ' + ,file.path('/usr/lib/R/site-library' + ,pkg$debname + ,'DESCRIPTION' + ) + ,sep='\n'), width=72), con=pkg$debfile('copyright.in')) +} + +prepare_new_debian <- function(pkg,extra_deps) { + # generate Debian version and name + pkg$debversion = new_build_version(pkg$name) + + # make the debian/ directory + debdir <- file.path(pkg$path,'debian') + pkg$debfile <- function(x) { file.path(debdir,x) } + unlink(debdir,recursive=T) + dir.create(debdir) + + # see if this is an architecture-dependent package. + # heuristic: if /src/ exists in pkg$path, then this is an + # architecture-dependent package. + # CRAN2DEB.pm is a bit fancier about this but ``Writing R extensions'' + # says: ``The sources and headers for the compiled code are in src, plus + # optionally file Makevars or Makefile.'' It seems unlikely that + # architecture independent code would end up here. + if (pkg$is_bundle) { + # if it's a bundle, check each of the packages + pkg$archdep = F + for (pkgname in r_bundle_contains(pkg$name)) { + pkg$archdep = file.exists(file.path(pkg$path,pkgname,'src')) + if (pkg$archdep) { + break + } + } + } else { + pkg$archdep = file.exists(file.path(pkg$path,'src')) + } + pkg$arch <- 'all' + if (pkg$archdep) { + pkg$arch <- host_arch() + } + + pkg$license <- accept_license(pkg) + pkg$depends <- get_dependencies(pkg,extra_deps) + generate_changelog(pkg) + generate_rules(pkg) + generate_copyright(pkg) + generate_control(pkg) + + # convert text to utf8 (who knows what the original character set is -- + # let's hope iconv DTRT). + for (file in c('control','changelog','copyright')) { + log_system('iconv -o ',shQuote(pkg$debfile(file)) + ,' -t utf8 ' + ,shQuote(pkg$debfile(paste(file,'in',sep='.')))) + file.remove(pkg$debfile(paste(file,'in',sep='.'))) + } + return(pkg) +} diff --git a/tags/gsoc_final/R/getrpkg.R b/tags/gsoc_final/R/getrpkg.R new file mode 100644 index 0000000..3c7e0af --- /dev/null +++ b/tags/gsoc_final/R/getrpkg.R @@ -0,0 +1,157 @@ +setup <- function() { + # set up the working directory + tmp <- tempfile('cran2deb') + dir.create(tmp) + return (tmp) +} + +cleanup <- function(dir) { + # remove the working directory + unlink(dir,recursive=T) + invisible() +} + +download_pkg <- function(dir, pkgname) { + # download pkgname into dir, and construct some metadata + + # record some basic information + pkg <- pairlist() + pkg$date_stamp = format(Sys.time(),'%a, %d %b %Y %H:%M:%S %z') + pkg$name = pkgname + pkg$repoURL = available[pkgname,'Repository'] + pkg$repo = repourl_as_debian(pkg$repoURL) + if (!length(grep('^[A-Za-z0-9][A-Za-z0-9+.-]+$',pkg$name))) { + fail('Cannot convert package name into a Debian name',pkg$name) + } + pkg$srcname = pkgname_as_debian(pkg$name,binary=F) + pkg$debname = pkgname_as_debian(pkg$name,repo=pkg$repo) + pkg$version <- available[pkgname,'Version'] + + # see if we have already built this release and uploaded it. + debfn <- file.path(pbuilder_results, paste(pkg$srcname, '_', pkg$version, '.orig.tar.gz', sep='')) + pkg$need_repack = FALSE + if (file.exists(debfn)) { + # if so, use the existing archive. this is good for three reasons: + # 1. it saves downloading the archive again + # 2. the repacking performed below changes the MD5 sum of the archive + # which upsets some Debian archive software. + # 3. why repack more than once? + pkg$archive <- file.path(dir, basename(debfn)) + file.copy(debfn,pkg$archive) + pkg$path = file.path(dir, paste(pkg$srcname ,pkg$version ,sep='-')) + } else { + # use this instead of download.packages as it is more resilient to + # dodgy network connections (hello BT 'OpenWorld', bad ISP) + fn <- paste(pkgname, '_', pkg$version, '.tar.gz', sep='') + url <- paste(available[pkgname,'Repository'], fn, sep='/') + archive <- file.path(dir, fn) + # don't log the output -- we don't care! + ret <- system(paste('curl','-o',shQuote(archive),'-m 720 --retry 5',shQuote(url))) + if (ret != 0) { + fail('failed to download',url) + } + # end of download.packages replacement + + if (length(grep('\\.\\.',archive)) || normalizePath(archive) != archive) { + fail('funny looking path',archive) + } + pkg$path = sub("_\\.(zip|tar\\.gz)", "" + ,gsub(.standard_regexps()$valid_package_version, "" + ,archive)) + pkg$archive = archive + # this is not a Debian conformant archive + pkg$need_repack = TRUE + } + return(pkg) +} + +repack_pkg <- function(pkg) { + # re-pack into a Debian-named archive with a Debian-named directory. + debpath = file.path(dirname(pkg$archive) + ,paste(pkg$srcname + ,pkg$version + ,sep='-')) + file.rename(pkg$path, debpath) + pkg$path = debpath + debarchive = file.path(dirname(pkg$archive) + ,paste(pkg$srcname,'_' + ,pkg$version,'.orig.tar.gz' + ,sep='')) + wd <- getwd() + setwd(dirname(pkg$path)) + # remove them pesky +x files + # BUT EXCLUDE configure and cleanup + log_system('find',shQuote(basename(pkg$path)) + ,'-type f -a ' + , '! \\( -name configure -o -name cleanup \\)' + ,'-exec chmod -x {} \\;') + # tar it all back up + log_system('tar -czf',shQuote(debarchive),shQuote(basename(pkg$path))) + setwd(wd) + file.remove(pkg$archive) + pkg$archive = debarchive + pkg$need_repack = FALSE + return(pkg) +} + +prepare_pkg <- function(dir, pkgname) { + # download and extract an R package named pkgname + # OR the bundle containing pkgname + + # based loosely on library/utils/R/packages2.R::install.packages + + # first a little trick; change pkgname if pkgname is contained in a bundle + if (!(pkgname %in% rownames(available))) { + bundle <- r_bundle_of(pkgname) + if (is.null(bundle)) { + fail('package',pkgname,'is unavailable') + } + pkgname <- bundle + } + + # grab the archive and some metadata + pkg <- download_pkg(dir, pkgname) + + # now extract the archive + if (!length(grep('\\.tar\\.gz',pkg$archive))) { + fail('archive is not tarball') + } + wd <- getwd() + setwd(dir) + ret = log_system('tar','xzf',shQuote(pkg$archive)) + setwd(wd) + if (ret != 0) { + fail('Extraction of archive',pkg$archive,'failed.') + } + + # if necessary, repack the archive into Debian-conformant format + if (pkg$need_repack) { + pkg <- repack_pkg(pkg) + } + if (!file.info(pkg$path)[,'isdir']) { + fail(pkg$path,'is not a directory and should be.') + } + + # extract the DESCRIPTION file, which contains much metadata + pkg$description = read.dcf(file.path(pkg$path,'DESCRIPTION')) + + # ensure consistency of version numbers + if ('Version' %in% names(pkg$description[1,])) { + if (pkg$description[1,'Version'] != available[pkg$name,'Version']) { + # should never happen since available is the basis upon which the + # package is retrieved. + error('available version:',available[pkg$name,'Version']) + error('package version:',pkg$description[1,'Version']) + fail('inconsistency between R package version and cached R version') + } + } + + pkg$is_bundle = 'Bundle' %in% names(pkg$description[1,]) + # note subtly of short circuit operators (no absorption) + if ((!pkg$is_bundle && pkg$description[1,'Package'] != pkg$name) || + ( pkg$is_bundle && pkg$description[1,'Bundle'] != pkg$name)) { + fail('package name mismatch') + } + return(pkg) +} + diff --git a/tags/gsoc_final/R/license.R b/tags/gsoc_final/R/license.R new file mode 100644 index 0000000..c392e11 --- /dev/null +++ b/tags/gsoc_final/R/license.R @@ -0,0 +1,147 @@ +is_acceptable_license <- function(license) { + # determine if license text is acceptable + + if (length(grep('^file ',license))) { + # skip file licenses + return(FALSE) + } + license <- license_text_reduce(license) + action = db_license_override_name(license) + if (!is.null(action)) { + return(action) + } + license <- license_text_further_reduce(license) + action = db_license_override_name(license) + if (!is.null(action)) { + warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!') + return(action) + } + license <- license_text_extreme_reduce(license) + action = db_license_override_name(license) + if (!is.null(action)) { + warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!') + return(action) + } + # TODO: file {LICENSE,LICENCE} (+ maybe COPYING?) + error('Wild license',license,'did not match classic rules; rejecting') + return(F) +} + +license_text_reduce <- function(license) { + # these reduction steps are sound for all conformant R license + # specifications. + + # compress spaces into a single space + license = gsub('[[:space:]]+',' ',license) + # make all characters lower case + license = tolower(license) + # don't care about versions of licenses + license = chomp(sub('\\( ?[<=>!]+ ?[0-9.-]+ ?\\)','' + ,sub('-[0-9.-]+','',license))) + # remove any extra space introduced + license = chomp(gsub('[[:space:]]+',' ',license)) + return(license) +} + +license_text_further_reduce <- function(license) { + # these reduction steps are heuristic and may lead to + # in correct acceptances, if care is not taken. + + # uninteresting urls + license = gsub('http://www.gnu.org/[[:alnum:]/._-]*','',license) + license = gsub('http://www.x.org/[[:alnum:]/._-]*','',license) + license = gsub('http://www.opensource.org/[[:alnum:]/._-]*','',license) + # remove all punctuation + license = gsub('[[:punct:]]+','',license) + # remove any extra space introduced + license = chomp(gsub('[[:space:]]+',' ',license)) + # redundant + license = gsub('the','',license) + license = gsub('see','',license) + license = gsub('standard','',license) + license = gsub('licen[sc]e','',license) + license = gsub('(gnu )?(gpl|general public)','gpl',license) + license = gsub('(mozilla )?(mpl|mozilla public)','mpl',license) + # remove any extra space introduced + license = chomp(gsub('[[:space:]]+',' ',license)) + return(license) +} + +license_text_extreme_reduce <- function(license) { + # remove everything that may or may not be a version specification + license = gsub('(ver?sion|v)? *[0-9.-]+ *(or *(higher|later|newer|greater|above))?','' + ,license) + # remove any extra space introduced + license = chomp(gsub('[[:space:]]+',' ',license)) + return(license) +} + +license_text_hash_reduce <- function(text) { + # reduction of license text, suitable for hashing. + return(chomp(tolower(gsub('[[:space:]]+',' ',text)))) +} + +get_license <- function(pkg,license) { + license <- chomp(gsub('[[:space:]]+',' ',license)) + if (length(grep('^file ',license))) { + if (length(grep('^file LICEN[CS]E$',license))) { + path = gsub('file ','',license) + path = file.path(pkg$path, path) + license <- license_text_reduce(readChar(path,file.info(path)$size)) + } else { + error('invalid license file specification',license) + return(NA) + } + } + return(license) +} + +get_license_hash <- function(pkg,license) { + return(digest(get_license(pkg,license),algo='sha1',serialize=FALSE)) +} + +is_acceptable_hash_license <- function(pkg,license) { + license_sha1 <- get_license_hash(pkg,license) + if (is.null(license_sha1)) { + return(FALSE) + } + action = db_license_override_hash(license_sha1) + if (is.null(action)) { + action = FALSE + } + if (action) { + warn('Wild license',license,'accepted via hash',license_sha1) + } + return(action) +} + + +accept_license <- function(pkg) { + # check the license + if (!('License' %in% names(pkg$description[1,]))) { + fail('package has no License: field in description!') + } + accept=NULL + for (license in strsplit(chomp(pkg$description[1,'License']) + ,'[[:space:]]*\\|[[:space:]]*')[[1]]) { + if (is_acceptable_license(license)) { + accept=license + break + } + if (is_acceptable_hash_license(pkg,license)) { + accept=license + break + } + } + if (is.null(accept)) { + fail('No acceptable license:',pkg$description[1,'License']) + } else { + notice('Auto-accepted license',accept) + } + if (accept == 'Unlimited') { + # definition of Unlimited from ``Writing R extensions'' + accept=paste('Unlimited (no restrictions on distribution or' + ,'use other than those imposed by relevant laws)') + } + return(accept) +} diff --git a/tags/gsoc_final/R/log.R b/tags/gsoc_final/R/log.R new file mode 100644 index 0000000..2a9be4e --- /dev/null +++ b/tags/gsoc_final/R/log.R @@ -0,0 +1,65 @@ +log_messages <- list() + +log_clear <- function() { + assign('log_messages',list(),envir=.GlobalEnv) +} + +log_add <- function(text,print=T) { + if (print) { + message(text) + } + assign('log_messages',c(log_messages, text),envir=.GlobalEnv) +} + +log_retrieve <- function() { + return(log_messages) +} + +notice <- function(...) { + log_add(paste('N:',...)) +} + +warn <- function(...) { + log_add(paste('W:',...)) +} + +error <- function(...) { + log_add(paste('E:',...)) +} + +fail <- function(...) { + txt <- paste('E:',...) + log_add(txt) + stop(txt) +} + +log_system <- function(...) { + r <- try((function() { + # pipe() does not appear useful here, since + # we want the return value! + # XXX: doesn't work with ; or | ! + tmp <- tempfile('log_system') + on.exit(unlink(tmp)) + cmd <- paste(...) + # unfortunately this destroys ret + #cmd <- paste(cmd,'2>&1','| tee',tmp) + cmd <- paste(cmd,'>',tmp,'2>&1') + ret <- system(cmd) + f <- file(tmp) + output <- readLines(f) + close(f) + unlink(tmp) + return(list(ret,output)) + })()) + if (inherits(r,'try-error')) { + fail('system failed on:',paste(...)) + } + for (line in r[[2]]) { + if (!length(grep('^[WENI]:',line))) { + line = paste('I:',line) + } + log_add(line) #,print=F) + } + return(r[[1]]) +} + diff --git a/tags/gsoc_final/R/rdep.R b/tags/gsoc_final/R/rdep.R new file mode 100644 index 0000000..141453b --- /dev/null +++ b/tags/gsoc_final/R/rdep.R @@ -0,0 +1,155 @@ + +r_bundle_of <- function(pkgname) { + # returns the bundle containing pkgname or NA + bundles <- names(available[!is.na(available[, 'Bundle']), 'Contains']) + # use the first bundle + for (bundle in bundles) { + if (pkgname %in% r_bundle_contains(bundle)) { + return(bundle) + } + } + return(NULL) +} + +r_bundle_contains <- function(bundlename) { + return(strsplit(available[bundlename,'Contains'],'[[:space:]]+')[[1]]) +} + +r_requiring <- function(names) { + for (name in names) { + if (!(name %in% base_pkgs) && !(name %in% rownames(available))) { + bundle <- r_bundle_of(name) + if (!is.null(bundle)) { + name = bundle + names <- c(names,bundle) + } + } + if (name %in% rownames(available) && !is.na(available[name,'Contains'])) { + names <- c(names,r_bundle_contains(name)) + } + } + # approximately prune first into a smaller availability + candidates <- rownames(available)[sapply(rownames(available) + ,function(name) + length(grep(paste(names,collapse='|') + ,available[name,r_depend_fields])) > 0)] + if (length(candidates) == 0) { + return(c()) + } + # find a logical index into available of every package/bundle + # whose dependency field contains at least one element of names. + # (this is not particularly easy to read---sorry---but is much faster than + # the alternatives i could think of) + prereq=c() + dep_matches <- function(dep) chomp(gsub('\\([^\\)]+\\)','',dep)) %in% names + any_dep_matches <- function(name,field=NA) + any(sapply(strsplit(chomp(available[name,field]) + ,'[[:space:]]*,[[:space:]]*') + ,dep_matches)) + + for (field in r_depend_fields) { + matches = sapply(candidates, any_dep_matches, field=field) + if (length(matches) > 0) { + prereq = c(prereq,candidates[matches]) + } + } + return(unique(prereq)) +} + +r_dependencies_of <- function(name=NULL,description=NULL) { + # find the immediate dependencies (children in the dependency graph) of an + # R package + if (!is.null(name) && (name == 'R' || name %in% base_pkgs)) { + return(data.frame()) + } + if (is.null(description) && is.null(name)) { + fail('must specify either a description or a name.') + } + if (is.null(description)) { + if (!(name %in% rownames(available))) { + bundle <- r_bundle_of(name) + if (!is.null(bundle)) { + name <- bundle + } else { + # unavailable packages don't depend upon anything + return(data.frame()) + } + } + description <- data.frame() + # keep only the interesting fields + for (field in r_depend_fields) { + if (!(field %in% names(available[name,]))) { + next + } + description[1,field] = available[name,field] + } + } + # extract the dependencies from the description + deps <- data.frame() + for (field in r_depend_fields) { + if (!(field %in% names(description[1,]))) { + next + } + new_deps <- lapply(strsplit(chomp(description[1,field]) + ,'[[:space:]]*,[[:space:]]*')[[1]] + ,r_parse_dep_field) + deps <- iterate(lapply(new_deps[!is.na(new_deps)],rbind),deps,rbind) + } + return (deps) +} + +r_parse_dep_field <- function(dep) { + if (is.na(dep)) { + return(NA) + } + # remove other comments + dep = gsub('(\\(\\)|\\([[:space:]]*[^<=>!].*\\))','',dep) + # squish spaces + dep = chomp(gsub('[[:space:]]+',' ',dep)) + # parse version + pat = '^([^ ()]+) ?(\\( ?([<=>!]+ ?[0-9.-]+) ?\\))?$' + if (!length(grep(pat,dep))) { + fail('R dependency',dep,'does not appear to be well-formed') + } + version = sub(pat,'\\3',dep) + dep = sub(pat,'\\1',dep) + if (!(dep %in% rownames(available))) { + depb <- r_bundle_of(dep) + if (!is.null(depb)) { + dep <- depb + } + } + return(list(name=dep,version=version)) +} + +r_dependency_closure <- function(fringe, forward_arcs=T) { + # find the transitive closure of the dependencies/prerequisites of some R + # packages + closure <- list() + if (is.data.frame(fringe)) { + fringe <- as.list(fringe$name) + } + fun = function(x) r_dependencies_of(name=x)$name + if (!forward_arcs) { + fun = r_requiring + } + while(length(fringe) > 0) { + # pop off the top + top <- fringe[[1]] + if (length(fringe) > 1) { + fringe <- fringe[2:length(fringe)] + } else { + fringe <- list() + } + src <- pkgname_as_debian(top,binary=F) + if (src == 'R') { + next + } + newdeps <- fun(top) + closure=c(closure,top) + fringe=c(fringe,newdeps) + } + # build order + return(rev(unique(closure,fromLast=T))) +} + diff --git a/tags/gsoc_final/R/util.R b/tags/gsoc_final/R/util.R new file mode 100644 index 0000000..e10951e --- /dev/null +++ b/tags/gsoc_final/R/util.R @@ -0,0 +1,25 @@ +iterate <- function(xs,z,fun) { + y <- z + for (x in xs) + y <- fun(y,x) + return(y) +} + +chomp <- function(x) { + # remove leading and trailing spaces + return(sub('^[[:space:]]+','',sub('[[:space:]]+$','',x))) +} + +host_arch <- function() { + # return the host system architecture + system('dpkg-architecture -qDEB_HOST_ARCH',intern=T) +} + +err <- function(...) { + error(...) + exit() +} + +exit <- function() { + q(save='no') +} diff --git a/tags/gsoc_final/R/version.R b/tags/gsoc_final/R/version.R new file mode 100644 index 0000000..184ec23 --- /dev/null +++ b/tags/gsoc_final/R/version.R @@ -0,0 +1,92 @@ +version_new <- function(rver,debian_revision=1, debian_epoch=db_get_base_epoch()) { + # generate a string representation of the Debian version of an + # R version of a package + pkgver = rver + + # ``Writing R extensions'' says that the version consists of at least two + # non-negative integers, separated by . or - + if (!length(grep('^([0-9]+[.-])+[0-9]+$',rver))) { + fail('Not a valid R package version',rver) + } + + # Debian policy says that an upstream version should start with a digit and + # may only contain ASCII alphanumerics and '.+-:~' + if (!length(grep('^[0-9][A-Za-z0-9.+:~-]*$',rver))) { + fail('R package version',rver + ,'does not obviously translate into a valid Debian version.') + } + + # if rver contains a : then the Debian version must also have a colon + if (debian_epoch == 0 && length(grep(':',pkgver))) + debian_epoch = 1 + + # if the epoch is non-zero then include it + if (debian_epoch != 0) + pkgver = paste(debian_epoch,':',pkgver,sep='') + + # always add the '-1' Debian release; nothing is lost and rarely will R + # packages be Debian packages without modification. + return(paste(pkgver,'-',debian_revision,sep='')) +} + +version_epoch <- function(pkgver) { + # return the Debian epoch of a Debian package version + if (!length(grep(':',pkgver))) + return(0) + return(as.integer(sub('^([0-9]+):.*','\\1',pkgver))) +} +# version_epoch . version_new(x,y) = id +# version_epoch(version_new(x,y)) = base_epoch + +version_revision <- function(pkgver) { + # return the Debian revision of a Debian package version + return(as.integer(sub('.*-([0-9]+)$','\\1',pkgver))) +} +# version_revision . version_new(x) = id +# version_revision(version_new(x)) = 1 + +version_upstream <- function(pkgver) { + # return the upstream version of a Debian package version + return(sub('-[0-9]+$','',sub('^[0-9]+:','',pkgver))) +} +# version_upstream . version_new = id + +version_update <- function(rver, prev_pkgver, prev_success) { + # return the next debian package version + prev_rver <- version_upstream(prev_pkgver) + if (prev_rver == rver) { + # increment the Debian revision if the previous build was successful + inc = 0 + if (prev_success) { + inc = 1 + } + return(version_new(rver + ,debian_revision = version_revision(prev_pkgver)+inc + ,debian_epoch = version_epoch(prev_pkgver) + )) + } + # new release + # TODO: implement Debian ordering over version and then autoincrement + # Debian epoch when upstream version does not increment. + return(version_new(rver + ,debian_epoch = version_epoch(prev_pkgver) + )) +} + +new_build_version <- function(pkgname) { + if (!(pkgname %in% rownames(available))) { + bundle <- r_bundle_of(pkgname) + if (is.null(bundle)) { + fail('tried to discover new version of',pkgname,'but it does not appear to be available') + } + name <- bundle + } + db_ver <- db_latest_build_version(pkgname) + db_succ <- db_latest_build_status(pkgname)[[1]] + latest_r_ver <- available[pkgname,'Version'] + if (!is.null(db_ver)) { + return(version_update(latest_r_ver, db_ver, db_succ)) + } + return(version_new(latest_r_ver)) +} + diff --git a/tags/gsoc_final/R/zzz.R b/tags/gsoc_final/R/zzz.R new file mode 100644 index 0000000..7d3584b --- /dev/null +++ b/tags/gsoc_final/R/zzz.R @@ -0,0 +1,25 @@ +.First.lib <- function(libname, pkgname) { + global <- function(name,value) assign(name,value,envir=.GlobalEnv) + global("maintainer", 'cran2deb autobuild ') + global("root", system.file(package='cran2deb')) + global("cache_root", '/var/cache/cran2deb') + global("pbuilder_results", '/var/cache/cran2deb/results') + global("pbuilder_config", file.path(root,'etc/pbuilderrc')) + global("dput_config", file.path(root,'etc/dput.cf')) + global("dinstall_config", file.path(root,'etc/mini-dinstall.conf')) + global("dinstall_archive", file.path(root,'var/archive')) + global("r_depend_fields", c('Depends','Imports')) # Suggests, Enhances + # git_revision { + global("git_revision","b79d88001537df06dac28c27be3d4887ca2d9238") + # git_revision } + global("changesfile", function(srcname,version='*') { + return(file.path(pbuilder_results + ,paste(srcname,'_',version,'_' + ,host_arch(),'.changes',sep=''))) + }) + + cache <- file.path(cache_root,'cache.rda') + if (file.exists(cache)) { + load(cache,envir=.GlobalEnv) + } +} diff --git a/tags/gsoc_final/README b/tags/gsoc_final/README new file mode 120000 index 0000000..a6047ac --- /dev/null +++ b/tags/gsoc_final/README @@ -0,0 +1 @@ +inst/doc/README \ No newline at end of file diff --git a/tags/gsoc_final/configure b/tags/gsoc_final/configure new file mode 100755 index 0000000..03aa5d9 --- /dev/null +++ b/tags/gsoc_final/configure @@ -0,0 +1,12 @@ +#!/bin/sh +# stamp the source with the originating git revision. +git_rev=$(git show --pretty'=oneline' 'HEAD' | head -n1 | cut -f1 -d' ') +#git_r='assign("git_revision","'$git_rev'",envir=.GlobalEnv)' +git_r=' global("git_revision","'$git_rev'")' + +awk -v "git_r=$git_r" ' +/# git_revision }/ {suppress=0} +suppress == 0 {print} +/# git_revision {/ {print git_r; suppress=1} +' R/zzz.R.new && \ +mv R/zzz.R.new R/zzz.R diff --git a/tags/gsoc_final/data/populate_depend_aliases b/tags/gsoc_final/data/populate_depend_aliases new file mode 100644 index 0000000..8b870c4 --- /dev/null +++ b/tags/gsoc_final/data/populate_depend_aliases @@ -0,0 +1,53 @@ +alias_build boost libboost-dev +alias_build boost libboost-graph-dev +alias ggobi ggobi +alias_build glade libglade2-dev +alias_run glade libglade2-0 +alias_build glib libglib2.0-dev +alias_run glib libglib2.0-0 +alias glu libglu1-mesa-dev +alias_build gmp libgmp3-dev +alias_run gmp libgmp3c2 +alias_build gsl libgsl0-dev +alias_run gsl libgsl0ldbl +alias_build ignore build-essential +alias_build java openjdk-6-jdk +alias_build java libgcj9-dev +alias_run java openjdk-6-jre +alias_build libatk libatk1.0-dev +alias_run libatk libatk1.0-0 +alias libcairo libcairo2-dev +alias_run libcurl libcurl3 +alias_build libcurl libcurl4-openssl-dev +alias_build libdieharder libdieharder-dev +alias_run libdieharder libdieharder2 +alias libfontconfig libfontconfig1-dev +alias libfreetype libfreetype6-dev +alias_build libgdal libgdal1-dev +alias_run libgdal libgdal1-1.5.0 +alias libgd libgd2-noxpm-dev +alias_build libgraphviz libgraphviz-dev +alias_run libgraphviz libgraphviz4 +alias_build libgtk libgtk2.0-dev +alias_run libgtk libgtk2.0-0 +alias libjpeg libjpeg62-dev +alias libmagick libmagick9-dev +alias_build libpango libpango1.0-dev +alias_run libpango libpango1.0-0 +alias_build libpng libpng12-dev +alias_run libpng libpng12-0 +alias libxml libxml2-dev +alias msttcorefonts msttcorefonts +alias_run netcdf libnetcdf4 +alias_build netcdf libnetcdf-dev +alias_build opengl libgl1-mesa-dev +alias_run opengl libgl1-mesa-glx +alias pari-gp pari-gp +alias proj proj +alias_build quantlib libquantlib0-dev +alias_run quantlib libquantlib-0.9.6 +alias_run sqlite libsqlite3-0 +alias_build sqlite libsqlite3-dev +alias zlib zlib1g-dev +alias cshell tsch|csh|c-shell +alias_build autotools autotools-dev diff --git a/tags/gsoc_final/data/populate_forcedep b/tags/gsoc_final/data/populate_forcedep new file mode 100644 index 0000000..cdd8495 --- /dev/null +++ b/tags/gsoc_final/data/populate_forcedep @@ -0,0 +1,7 @@ +force java rJava +force autotools rJava +force sqlite RSQLite +force sqlite SQLiteDF +force boost RBGL +force netcdf ncdf +force cshell dse diff --git a/tags/gsoc_final/data/populate_licenses b/tags/gsoc_final/data/populate_licenses new file mode 100644 index 0000000..89980b9 --- /dev/null +++ b/tags/gsoc_final/data/populate_licenses @@ -0,0 +1,89 @@ +accept AGPL +accept APACHE +accept ARTISTIC +accept BSD +accept CeCILL +accept CPL +accept GPL +accept GPLQA +accept GPL+QHULL +accept LGPL +accept MIT +accept MPL +accept TCLTK2 +accept UNLIMITED +accept X11 +reject distrib-noncomm +reject GPL+ACM +reject MCLUST +reject UNCLEAR +hash APACHE /usr/share/common-licenses/Apache-2.0 +hash ARTISTIC /usr/share/common-licenses/Artistic +hash BSD /usr/share/common-licenses/BSD +hash GPL /usr/share/common-licenses/GPL-2 +hash GPL /usr/share/common-licenses/GPL-3 +hash LGPL /usr/share/common-licenses/LGPL-2 +hash LGPL /usr/share/common-licenses/LGPL-2.1 +hash LGPL /usr/share/common-licenses/LGPL-3 +pkg BSD minpack.lm +pkg CeCILL LLAhclust +pkg CPL lmom +pkg distrib-noncomm Bhat +pkg distrib-noncomm conf.design +pkg distrib-noncomm gpclib +pkg distrib-noncomm mlbench +pkg distrib-noncomm poplab +pkg distrib-noncomm PredictiveRegression +pkg distrib-noncomm PTAk +pkg distrib-noncomm siggenes +pkg GPL+ACM akima +pkg GPL+ACM tripack +pkg GPL degreenet +pkg GPL ergm +pkg GPL gmodels +pkg GPL ICE +pkg GPL latentnet +pkg GPL network +pkg GPL networksis +pkg GPL pastecs +pkg GPL pbatR +pkg GPL PKtools +pkg GPL+QHULL geometry +pkg GPL reldist +pkg GPL RXshrink +pkg GPL snpMatrix +pkg GPL splancs +pkg GPL statnet +pkg GPL uroot +pkg LGPL R.huge +pkg MCLUST mclust +pkg TCLTK2 tcltk2 +pkg UNCLEAR adapt +pkg UNCLEAR cat +pkg UNCLEAR cosmo +pkg UNCLEAR mix +pkg UNCLEAR mlmm +pkg UNCLEAR norm +pkg UNCLEAR pan +pkg UNCLEAR titecrm +pkg UNCLEAR tlnise +pkg UNLIMITED boolean +pkg GPLQA regtest +pkg GPL gllm +pkg GPL rake +pkg GPL Rigroup +pkg GPL ICEinfer +pkg GPL partsm +pkg GPL timsac +pkg GPL HTMLapplets +pkg GPL moc +ls +pkg GPL ibdreg +pkg AGPL accuracy +pkg AGPL Zelig +pkg GPL TWIX +pkg GPL aplpack +accept distrib-noncomm +accept GPL+ACM +accept MCLUST +accept UNCLEAR diff --git a/tags/gsoc_final/data/populate_sysreq b/tags/gsoc_final/data/populate_sysreq new file mode 100644 index 0000000..02b3316 --- /dev/null +++ b/tags/gsoc_final/data/populate_sysreq @@ -0,0 +1,34 @@ +sysreq ignore gcc +sysreq ignore gnu make +sysreq ignore % if present +sysreq ignore none +sysreq libcurl curl +sysreq ggobi ggobi +sysreq libatk atk +sysreq libcairo cairo +sysreq libdieharder dieharder% +sysreq libfontconfig fontconfig +sysreq libfreetype freetype +sysreq libfreetype %freetype +sysreq libgd libgd +sysreq libgdal %gdal% +sysreq opengl opengl +sysreq glade %glade +sysreq glib glib +sysreq glu glu library +sysreq gmp gmp +sysreq libgraphviz graphviz +sysreq gsl gnu gsl% +sysreq gsl gnu scientific library +sysreq libgtk gtk% +sysreq libjpeg libjpeg% +sysreq libmagick imagemagick +sysreq libpango pango +sysreq libpng libpng +sysreq quantlib quantlib% +sysreq libxml libxml% +sysreq msttcorefonts msttcorefonts +sysreq pari-gp pari/gp +sysreq proj proj% +sysreq zlib zlib +sysreq java java diff --git a/tags/gsoc_final/data/quit b/tags/gsoc_final/data/quit new file mode 100644 index 0000000..ff60466 --- /dev/null +++ b/tags/gsoc_final/data/quit @@ -0,0 +1 @@ +quit diff --git a/tags/gsoc_final/exec/autobuild b/tags/gsoc_final/exec/autobuild new file mode 100755 index 0000000..0b24cba --- /dev/null +++ b/tags/gsoc_final/exec/autobuild @@ -0,0 +1,15 @@ +#!/usr/bin/env r +## DOC: cran2deb autobuild +## DOC: automatically builds all out of date packages. +## DOC: +suppressMessages(library(cran2deb)) + +if (exists('argv')) { # check for littler + db_update_package_versions() + outdated <- db_outdated_packages() + build_order <- r_dependency_closure(outdated) + notice('build order',paste(build_order,collapse=', ')) + for (pkg in build_order) { + build(pkg,c()) + } +} diff --git a/tags/gsoc_final/exec/build b/tags/gsoc_final/exec/build new file mode 100755 index 0000000..b875e60 --- /dev/null +++ b/tags/gsoc_final/exec/build @@ -0,0 +1,43 @@ +#!/usr/bin/env r +## DOC: cran2deb build [-D extra_dep1,extra_dep2,...] package1 package2 ... +## DOC: builds a particular package. +## DOC: +suppressMessages(library(cran2deb)) + +if (exists('argv')) { # check for littler + argc <- length(argv) + extra_deps = list() + extra_deps$deb = c() + extra_deps$r = c() + opts = c('-D','-R') + # first argument is the root --- this is dealt with elsewhere. + for (i in 2:argc) { + if (!(argv[i] %in% opts)) { + if (argc >= i) { + argv <- argv[i:argc] + } else { + argv <- list() + } + argc = argc - i + 1 + break + } + if (i == argc) { + err('missing argument') + } + if (argv[i] == '-D') { + extra_deps$deb = c(extra_deps$deb,strsplit(chomp(argv[i+1]),',')[[1]]) + } + if (argv[i] == '-R') { + extra_deps$r = c(extra_deps$r,strsplit(chomp(argv[i+1]),',')[[1]]) + extra_deps$deb = c(extra_deps$deb,lapply(extra_deps$r,pkgname_as_debian)) + } + } + if (argc == 0) { + err('usage: cran2deb [-D extra_dep1,extra_dep2,...] package package ...') + } + build_order <- r_dependency_closure(c(extra_deps$r,argv)) + notice('build order',paste(build_order,collapse=', ')) + for (pkg in build_order) { + build(pkg,extra_deps,force=pkg %in% argv) + } +} diff --git a/tags/gsoc_final/exec/build_ctv b/tags/gsoc_final/exec/build_ctv new file mode 100755 index 0000000..35d9a42 --- /dev/null +++ b/tags/gsoc_final/exec/build_ctv @@ -0,0 +1,14 @@ +#!/usr/bin/env rc +## DOC: cran2deb build_ctv +## DOC: build all CRAN TaskViews. warning and error logs in ./ctv/ +## DOC: + +for (ctv in `{cran2deb cran_pkgs query}) { + echo task view $ctv... + if (![ -e ctv/$ctv ]) { + cran2deb build_some $ctv + mkdir -p ctv/$ctv + mv warn fail ctv/$ctv + } +} + diff --git a/tags/gsoc_final/exec/build_some b/tags/gsoc_final/exec/build_some new file mode 100755 index 0000000..679eed2 --- /dev/null +++ b/tags/gsoc_final/exec/build_some @@ -0,0 +1,36 @@ +#!/usr/bin/rc +## DOC: cran2deb build_some [taskview1 taskview2 ...] +## DOC: build some packages, logging warnings into ./warn/$package +## DOC: and failures into ./fail/$package. with no arguments a random +## DOC: sample of packages is built. the file ./all_pkgs overrides this +## DOC: behaviour and is expected to be a list of packages to build. +## DOC: + +mkdir -p warn fail +shift +if ([ ! -e all_pkgs ]) { + cran2deb cran_pkgs $* >all_pkgs +} +for (pkg in `{cat all_pkgs}) { + if (~ $pkg *..* */*) { + echo bad name $pkg >>fail/ERROR + } else if ([ -e warn/$pkg ]) { + echo skipping $pkg... + } else if ([ -e fail/$pkg ]) { + echo skipping failed $pkg... + } else { + echo -n .. package $pkg + fail=0 + cran2deb build $pkg >fail/$pkg >[2=1] || fail=1 + if (~ $fail 0) { + echo success + grep '^[WE]:' fail/$pkg >warn/$pkg +# if (~ `{stat -c '%s' warn/$pkg} 0) { +# rm -f warn/$pkg +# } + rm -f fail/$pkg + } else { + echo FAILED + } + } +} diff --git a/tags/gsoc_final/exec/copy_find b/tags/gsoc_final/exec/copy_find new file mode 100755 index 0000000..eebcec1 --- /dev/null +++ b/tags/gsoc_final/exec/copy_find @@ -0,0 +1,33 @@ +#!/usr/bin/rc +## DOC: cran2deb copy_find path +## DOC: a tool for finding (heuristically) some copyright notices. +## DOC: +kwords='copyright|warranty|redistribution|modification|patent|trademark|licen[cs]e|permission' +nl=`` () {printf '\n'} +ifs=$nl { + files=`{find $1 ! -path '*debian*' -type f} + lines=() + for (file in $files) { + notices=`{grep -H '(C)' $file} + notices=($notices `{grep -HEi $kwords $file}) + lines=($lines `{{for (notice in $notices) echo $notice} | sort -u}) + } + # let's hope no file has a : in it + ifs=() { seen_files=`{{for (line in $lines) echo $line} | cut -d: -f1} } + missing_copyright=() + for (file in $files) { + if (echo -n $seen_files | grep -q '^'^$file^'$') { + } else { + missing_copyright=($missing_copyright $file) + } + } + echo 'Suspect copyright notices:' + for (line in $lines) echo ' '$line + echo 'Files without *suspect* copyright notices:' + for (missing in $missing_copyright) { + echo ' '$missing + echo ' type: '`{file $missing} + echo ' chars: '`{wc -c $missing | awk '{print $1}'} + echo ' lines: '`{wc -l $missing | awk '{print $1}'} + } +} diff --git a/tags/gsoc_final/exec/cran2deb b/tags/gsoc_final/exec/cran2deb new file mode 100755 index 0000000..a28879c --- /dev/null +++ b/tags/gsoc_final/exec/cran2deb @@ -0,0 +1,9 @@ +#!/usr/bin/rc +root=`{r -e 'suppressMessages(library(cran2deb));cat(system.file(package=''cran2deb''),file=stdout())'} +cmd=$1 +shift +if ([ ! -x $root/exec/$cmd ]) { + echo unknown command $cmd + exit 1 +} +$root/exec/$cmd $root $* diff --git a/tags/gsoc_final/exec/cran_pkgs b/tags/gsoc_final/exec/cran_pkgs new file mode 100755 index 0000000..b8a2dcb --- /dev/null +++ b/tags/gsoc_final/exec/cran_pkgs @@ -0,0 +1,28 @@ +#!/usr/bin/env r +## DOC: cran2deb cran_pkgs +## DOC: print a list of 800 packages picked at random +## DOC: cran2deb cran_pkgs query +## DOC: print the names of all CRAN TaskViews +## DOC: cran2deb cran_pkgs taskview1 taskview2 ... +## DOC: print the names of all packages in a particular CRAN TaskView +## DOC: + +library(cran2deb) + +if (length(argv) == 1) { + writeLines(sample(dimnames(available)[[1]],800)) +} else { + argv = argv[2:length(argv)] + if (argv[1] == 'query') { + for (ctv in ctv.available) { + writeLines(ctv$name) + } + q(save='no') + } + # list of task lists + for (ctv in ctv.available) { + if (ctv$name %in% argv) { + writeLines(ctv$packagelist$name) + } + } +} diff --git a/tags/gsoc_final/exec/depend b/tags/gsoc_final/exec/depend new file mode 100755 index 0000000..f4a100a --- /dev/null +++ b/tags/gsoc_final/exec/depend @@ -0,0 +1,82 @@ +#!/usr/bin/env r +## DOC: cran2deb depend +## DOC: add dependency aliases, system requirements and forced dependencies +## DOC: + +suppressPackageStartupMessages(library(cran2deb)) +suppressPackageStartupMessages(library(digest)) + +exec_cmd <- function(argc, argv) { + usage <- function() + message(paste('usage: alias ' + ,' alias_run ' + ,' alias_build ' + ,' sysreq ' + ,' force ' + ,' ls [aliases|force|sysreq]' + ,' quit' + ,sep='\n')) + + if (argc < 1) { + return() + } + cmd = argv[1] + + if (cmd == 'alias') { + if (argc < 3) { + usage() + return() + } + alias = argv[2] + pkg = argv[3] + db_add_depends(alias, pkg, build=T) + pkg = gsub('-dev$','',pkg) + db_add_depends(alias, pkg, build=F) + } else if (cmd == 'alias_run' || cmd == 'alias_build') { + if (argc < 3) { + usage() + return() + } + db_add_depends(argv[2], argv[3], cmd == 'alias_build') + } else if (cmd == 'sysreq') { + if (argc < 3) { + usage() + return() + } + sysreq = paste(argv[3:argc],collapse=' ') + db_add_sysreq_override(sysreq,argv[2]) + } else if (cmd == 'force') { + if (argc < 3) { + usage() + return() + } + db_add_forced_depends(argv[3],argv[2]) + } else if (cmd == 'ls') { + if (argc < 2 || argv[2] == 'aliases') { + print(db_depends()) + } else if (argv[2] == 'sysreq') { + print(db_sysreq_overrides()) + } else if (argv[2] == 'force') { + print(db_forced_depends()) + } else { + usage() + return() + } + } else if (cmd == 'quit') { + exit() + } else if (cmd == '#') { + } else { + usage() + return() + } +} + +argc <- length(argv) +if (argc > 1) { + exec_cmd(argc-1,argv[c(2:argc)]) +} else { + while(T) { + argv <- strsplit(readline('depend> '),'[[:space:]]+')[[1]] + exec_cmd(length(argv),argv) + } +} diff --git a/tags/gsoc_final/exec/diagnose b/tags/gsoc_final/exec/diagnose new file mode 100755 index 0000000..3740b50 --- /dev/null +++ b/tags/gsoc_final/exec/diagnose @@ -0,0 +1,72 @@ +#!/usr/bin/rc + +success=`{ls /var/cache/cran2deb/results/*.deb | wc -l} +echo $success successful packages +total=$success + +fn count_dup { sort | uniq -c | sort -n}# | awk '$1 > 1{print}' } +fn collapse { a=`{echo $^* | sed -e 's/ | /|/g'}; echo $^a } +echo 'warnings:' +{for (x in (warn/* /dev/null)) cut -d: -f3- <$x | sort -u} | awk '{print $1}' | count_dup +echo + +faildep=('^Error: package ''.*'' could not be loaded' + '|' '^ERROR: lazy loading failed for package ''.*''' + '|' '^[[:space:]]*package .* is not available' + '|' 'there is no package called ''.*''') +faildeb='do not know what to do with SystemRequirement:' +faillic=('No acceptable license: ') +failspc=': No space left on device' +failhdr='error: .*\.hp?p?: No such file or directory' +faildep=`{collapse $faildep} +faildep=$^faildep +faillic=`{collapse $faillic} +faillic=$^faillic +other='' + +nfaildep=`{grep -El $faildep fail/* /dev/null | wc -l} +echo $nfaildep failed R dependencies. +grep -Eh $faildep fail/* | count_dup +other=$faildep +#total=$total+$nfaildep +echo + +nfaillic=`{grep -El $faillic `{grep -EL $other fail/*} /dev/null | wc -l} +echo $nfaillic failed licenses. +grep -Eh $faillic `{grep -EL $other fail/*} | count_dup +other=$other^'|'^$faillic +total=$total+$nfaillic +echo + +nfailspc=`{grep -El $failspc `{grep -EL $other fail/*} /dev/null | wc -l} +echo $nfailspc out of space +other=$other^'|'^$failspc +total=$total+$nfailspc +echo + +nfailhdr=`{grep -El $failhdr `{grep -EL $other fail/*} /dev/null | wc -l} +echo $nfailhdr missing C header +grep -Eh $failhdr `{grep -EL $other fail/* /dev/null} | count_dup +other=$other^'|'^$failhdr +total=$total+$nfailhdr +echo + +nfaildeb=`{grep -El $faildeb `{grep -EL $other fail/*} /dev/null | wc -l} +echo $nfaildeb system requirement failures. +grep -Eh $faildeb `{grep -EL $other fail/* /dev/null} | count_dup +other=$other^'|'^$faildeb +total=$total+$nfaildeb +echo + +nfailother=`{hoc -e `{grep -EL $other fail/* /dev/null | wc -l}^-1} +echo $nfailother other failures. + +total=`{hoc -e $total} +succrate=`{hoc -e $success/'('$total')*100'} +echo $succrate% success rate '('$total' total)' +#total=`{hoc -e $total-$nfaillic-$nfailspc-$nfailhdr} +total=`{hoc -e $total-$nfaillic-$nfailspc} +succrate=`{hoc -e $success/'('$total')*100'} +echo $succrate% success rate with exclusions '('$total' total)' +grep -EL $other fail/* /dev/null | xargs tail -n 20 + diff --git a/tags/gsoc_final/exec/diagnose_ctv b/tags/gsoc_final/exec/diagnose_ctv new file mode 100755 index 0000000..b1f995d --- /dev/null +++ b/tags/gsoc_final/exec/diagnose_ctv @@ -0,0 +1,2 @@ +#!/usr/bin/env rc +{for (x in ctv/*) {echo;echo;echo $x: ; cd $x && cran2deb diagnose && cd ../..}} >ctv.results diff --git a/tags/gsoc_final/exec/get_base_pkgs b/tags/gsoc_final/exec/get_base_pkgs new file mode 100755 index 0000000..d08d625 --- /dev/null +++ b/tags/gsoc_final/exec/get_base_pkgs @@ -0,0 +1,4 @@ +#!/usr/bin/env r +for (pkg in rownames(installed.packages())) { + message(pkg) +} diff --git a/tags/gsoc_final/exec/help b/tags/gsoc_final/exec/help new file mode 100755 index 0000000..e7397f8 --- /dev/null +++ b/tags/gsoc_final/exec/help @@ -0,0 +1,6 @@ +#!/usr/bin/rc +echo usage: cran2deb ' [args ...]' +echo where '' is one of +grep '## [D]OC:' $1/exec/* | sed -e 's/.*[D]OC://' +echo +echo installation root is: $1 diff --git a/tags/gsoc_final/exec/license b/tags/gsoc_final/exec/license new file mode 100755 index 0000000..74e01a5 --- /dev/null +++ b/tags/gsoc_final/exec/license @@ -0,0 +1,126 @@ +#!/usr/bin/env r +## DOC: cran2deb license +## DOC: add licenses and change acceptance/rejection of licenses +## DOC: + +suppressPackageStartupMessages(library(cran2deb)) +suppressPackageStartupMessages(library(digest)) + +exec_cmd <- function(argc, argv) { + usage <- function() + message(paste('usage: accept ' + ,' reject ' + ,' hash (|)' + ,' pkg ' + ,' view ' + ,' ls' + ,' quit' + ,sep='\n')) + + if (argc < 1) { + exit() + } + cmd = argv[1] + + if (cmd == 'accept' || cmd == 'reject') { + if (argc != 2) { + usage() + return() + } + action = (cmd == 'accept') + db_add_license_override(argv[2],action) + } else if (cmd == 'hash') { + if (argc != 3) { + usage() + return() + } + license = argv[2] + path = argv[3] + if (is.null(db_license_override_name(license))) { + error('license',license,'is not known; add it first') + return() + } + if (file.exists(path)) { + license_sha1 = digest(readChar(path,file.info(path)$size) + ,algo='sha1', serialize=FALSE) + } else if (length(grep('^[0-9a-f]{40}$',path))) { + license_sha1 = path + } else { + error(path,'does not exist and does not look like an SHA1 hash') + return() + } + db_add_license_hash(license,license_sha1) + } else if (cmd == 'pkg') { + if (argc != 3) { + usage() + return() + } + license <- argv[2] + pkg_name <- argv[3] + current_action <- db_license_override_name(license) + if (is.null(current_action)) { + notice('license',license,'is not known; add it') + return() + } + action = 'accept' + if (!current_action) { + action = 'reject' + } + notice('in future, will',action,'the package',pkg_name,'under license',license) + tmp <- setup() + success <- try((function() { + pkg <- prepare_pkg(tmp,pkg_name) + if (!('License' %in% names(pkg$description[1,]))) { + error('package',pkg$name,'has no License: field in DESCRIPTION') + return() + } + first_license = (strsplit(chomp(pkg$description[1,'License']) + ,'[[:space:]]*\\|[[:space:]]*')[[1]])[1] + license_sha1 <- get_license_hash(pkg,first_license) + db_add_license_hash(license,license_sha1) + })()) + cleanup(tmp) + if (inherits(success,'try-error')) { + return() + } + } else if (cmd == 'view') { + if (argc != 2) { + usage() + return() + } + pkg_name <- argv[2] + tmp <- setup() + success <- try((function() { + pkg <- prepare_pkg(tmp,pkg_name) + if (!('License' %in% names(pkg$description[1,]))) { + error('package',pkg$name,'has no License: field in DESCRIPTION') + return() + } + first_license = (strsplit(chomp(pkg$description[1,'License']) + ,'[[:space:]]*\\|[[:space:]]*')[[1]])[1] + first_license = get_license(pkg,first_license) + cat(strwrap(first_license),file='|less') + })()) + cleanup(tmp) + if (inherits(success,'try-error')) { + return() + } + } else if (cmd == 'ls') { + for (x in db_license_overrides()) print(x) + } else if (cmd == 'help') { + usage() + return() + } else if (cmd == 'quit') { + exit() + } +} + +argc <- length(argv) +if (argc > 1) { + exec_cmd(argc-1,argv[c(2:argc)]) +} else { + while(T) { + argv <- strsplit(readline('license> '),'[[:space:]]+')[[1]] + exec_cmd(length(argv),argv) + } +} diff --git a/tags/gsoc_final/exec/root b/tags/gsoc_final/exec/root new file mode 100755 index 0000000..7294588 --- /dev/null +++ b/tags/gsoc_final/exec/root @@ -0,0 +1,2 @@ +#!/usr/bin/rc +echo $1 diff --git a/tags/gsoc_final/exec/update b/tags/gsoc_final/exec/update new file mode 100755 index 0000000..a2cdf01 --- /dev/null +++ b/tags/gsoc_final/exec/update @@ -0,0 +1,41 @@ +#!/usr/bin/rc +## DOC: cran2deb update +## DOC: update the cran2deb cache and database +## DOC: cran2deb update full +## DOC: force a full update of the cran2deb cache and database +## DOC: + +umask 022 +root=$1 +shift +for (x in `{find $root/etc -type f -name '*.in'}) { + y=`{echo $x | sed -e 's,.in$,,'} + sed -e 's:@ROOT@:'^$root^':g' <$x >$y +} +mkdir -p /var/cache/cran2deb/results || exit 1 +if ([ ! -e $root/var/archive ]) { + # I symbolically link this into /var/www/ + mkdir $root/var/archive || exit 1 +} +mini-dinstall --batch -c $root/etc/mini-dinstall.conf || exit 1 +update_period=10800 +if (~ $1 full || ![ -e /var/cache/cran2deb/cache.rda ] ) { + delta=`{awk 'END{print '^$update_period^'+1}' &1 >/dev/null <' + ,shQuote(file.path(root,'exec/get_base_pkgs')) + ,'| grep -v ^W:'))) + +message('updating list of existing Debian packages...') +debian_pkgs <- readLines(pipe('apt-cache rdepends r-base-core | sed -e "/^ r-cran/{s/^[[:space:]]*r/r/;p}" -e d | sort -u')) + +save(debian_pkgs, base_pkgs, available, ctv.available, file=file.path(cache_root,'cache.rda'),eval.promises=T) diff --git a/tags/gsoc_final/inst/doc/README b/tags/gsoc_final/inst/doc/README new file mode 100644 index 0000000..038e70a --- /dev/null +++ b/tags/gsoc_final/inst/doc/README @@ -0,0 +1,47 @@ +To install: + +$ cd .. +$ R CMD INSTALL cran2deb + +copy cran2deb/exec/cran2deb into somewhere in your executable path (e.g., +/usr/local/bin, $home/bin) + + + +To configure: + +1. You need a web server serving from say, /var/www/cran2deb/ + +Let ROOT be the value returned by running: cran2deb root + +2. ROOT/var/archive should be a symlink pointing to /var/www/cran2deb/ + $ rm ROOT/var/archive + $ ln -s /var/www/cran2deb/ ROOT/var/archive +3. modify OTHERMIRROR of ROOT/etc/pbuilderrc.in to point to your webserver +4. cran2deb needs a persistent cache outside of R's control. therefore, create + /var/cache/cran2deb, writable by whichever user(s) will run cran2deb. +5. run: cran2deb update +6. Try building a simple package: cran2deb build zoo + (The result will be in /var/cache/cran2deb/results) + + + +Useful commands: +cran2deb build + +cran2deb autobuild + - tries to build everything in the database that is out of date or failed on last build. + +cran2deb license + - license console for adding new licenses. see ROOT/data/populate_licenses for examples + +cran2deb depend + - dependency console for adding more dependencies, forced dependencies, system requirement patterns, and aliases. + see ROOT/data/populate_depend_aliases + populate_forcedep + populate_sysreq + +cran2deb update + - update the various caches and databases from the latest cran2deb static data, CRAN/BioC repos, and Debian + repos (for the pbuilder chroot) + diff --git a/tags/gsoc_final/inst/etc/dput.cf.in b/tags/gsoc_final/inst/etc/dput.cf.in new file mode 100644 index 0000000..7d6b8d2 --- /dev/null +++ b/tags/gsoc_final/inst/etc/dput.cf.in @@ -0,0 +1,8 @@ +[local] +method = local +incoming = @ROOT@/var/archive/mini-dinstall/incoming +allow_non-us_software = 1 +run_dinstall = 0 +run_lintian = 1 +post_upload_command = /usr/bin/mini-dinstall --batch -c @ROOT@/etc/mini-dinstall.conf +allow_unsigned_uploads = 1 diff --git a/tags/gsoc_final/inst/etc/hook/A80rjava b/tags/gsoc_final/inst/etc/hook/A80rjava new file mode 100755 index 0000000..1d37c8b --- /dev/null +++ b/tags/gsoc_final/inst/etc/hook/A80rjava @@ -0,0 +1,4 @@ +if [ -n "$(which java)" ] +then + R CMD javareconf +fi diff --git a/tags/gsoc_final/inst/etc/hook/B90lintian b/tags/gsoc_final/inst/etc/hook/B90lintian new file mode 100755 index 0000000..57fcfc4 --- /dev/null +++ b/tags/gsoc_final/inst/etc/hook/B90lintian @@ -0,0 +1,6 @@ +#!/bin/bash +# example file to be used with --hookdir +# +# run lintian on generated deb files +apt-get install -y --force-yes lintian +lintian /tmp/buildd/*.deb diff --git a/tags/gsoc_final/inst/etc/hook/B91dpkg-i b/tags/gsoc_final/inst/etc/hook/B91dpkg-i new file mode 100755 index 0000000..ee031bb --- /dev/null +++ b/tags/gsoc_final/inst/etc/hook/B91dpkg-i @@ -0,0 +1,28 @@ +#!/bin/bash +# example file to be used with --hookdir +# +# try to install the resulting debs. + +echo "Trying to install resulting packages and test upgrades" +set -ex + + +PKGNAMES=$(cd /tmp/buildd && ls -1 *.deb | sed 's/_.*$//' ) + +# install-remove check +dpkg -i /tmp/buildd/*.deb +dpkg --remove $PKGNAMES + +# install-purge check +dpkg -i /tmp/buildd/*.deb +dpkg --purge $PKGNAMES + +# upgrade-remove check +apt-get install -y --force-yes $PKGNAMES || true +dpkg -i /tmp/buildd/*.deb +dpkg --remove $PKGNAMES + +# upgrade-purge check +apt-get install -y --force-yes $PKGNAMES || true +dpkg -i /tmp/buildd/*.deb +dpkg --purge $PKGNAMES diff --git a/tags/gsoc_final/inst/etc/hook/B92test-pkg b/tags/gsoc_final/inst/etc/hook/B92test-pkg new file mode 100755 index 0000000..7372ca0 --- /dev/null +++ b/tags/gsoc_final/inst/etc/hook/B92test-pkg @@ -0,0 +1,52 @@ +#!/bin/bash +# example file to be used with --hookdir +# +# run tests. Current directory is top of source-code. +# +# 2005, 2007 Junichi Uekawa +# +set -e + +echo "Installing the prerequisites" +for PKG in $(ls /tmp/buildd/*.deb | sed -e's,.*/,,;s,_.*,,' ); do + apt-get install -y --force-yes "$PKG" || true + apt-get remove -y "$PKG" || true +done +# ignore the failures since they are not the prime interest + +dpkg -i /tmp/buildd/*.deb + +if chmod a+x /tmp/buildd/*/debian/pbuilder-test/*; then + : +else + echo "W: no pbuilder-test script found, skipping" + exit 0 +fi + +SUCCESS=0 +COUNT=0 +unset FAIL || true +NOFAIL=1 + +# The current directory is the top of the source-tree. +cd /tmp/buildd/*/debian/.. + +for SCRIPT in $(run-parts --test /tmp/buildd/*/debian/pbuilder-test) ; do + echo "--- BEGIN test: ${SCRIPT##*/}" + if "${SCRIPT}"; then + echo SUCCESS + ((SUCCESS=SUCCESS+1)) + else + echo FAIL + FAIL[${#FAIL[@]}]="${SCRIPT##*/}" + NOFAIL=0 + fi + echo "--- END test: ${SCRIPT##*/}" + ((COUNT=COUNT+1)) +done + +echo "Summary:" +echo "=== $SUCCESS out of $COUNT tests passed" +echo "${FAIL[@]/#/ failed }" +echo "-- end of testsuite." + diff --git a/tags/gsoc_final/inst/etc/hook/D70aptupdate b/tags/gsoc_final/inst/etc/hook/D70aptupdate new file mode 100755 index 0000000..4d42b3d --- /dev/null +++ b/tags/gsoc_final/inst/etc/hook/D70aptupdate @@ -0,0 +1 @@ +/usr/bin/apt-get update diff --git a/tags/gsoc_final/inst/etc/mini-dinstall.conf.in b/tags/gsoc_final/inst/etc/mini-dinstall.conf.in new file mode 100644 index 0000000..b75f1d7 --- /dev/null +++ b/tags/gsoc_final/inst/etc/mini-dinstall.conf.in @@ -0,0 +1,12 @@ +[DEFAULT] +architectures = all, i386 +use_dnotify = 0 +verify_sigs = 0 +mail_on_success = 0 +archive_style = simple-subdir +mail_log_level = NONE +archivedir = @ROOT@/var/archive +logfile = @ROOT@/var/mini-dinstall.log + +[unstable] + diff --git a/tags/gsoc_final/inst/etc/pbuilderrc.in b/tags/gsoc_final/inst/etc/pbuilderrc.in new file mode 100644 index 0000000..0724261 --- /dev/null +++ b/tags/gsoc_final/inst/etc/pbuilderrc.in @@ -0,0 +1,12 @@ +BASETGZ=/var/cache/pbuilder/base-cran2deb.tgz +HOOKDIR=@ROOT@/etc/hook +BUILDRESULT=/var/cache/cran2deb/results +EXTRAPACKAGES='debhelper r-base-dev cdbs r-base-core lintian xvfb xauth xfonts-base' +REMOVEPACKAGES='lilo libldap-2.4-2 libopencdk10 libsasl2-2' +# don't actually need aptitude, but pbuilder insists... +#REMOVEPACKAGES+='aptitude libcwidget3 libept0 libncursesw5 libsigc++-2.0-0c2a libxapian15' +DISTRIBUTION=unstable +OTHERMIRROR='deb http://localhost/users/cb/cran2deb/ unstable/$(ARCH)/ | deb http://localhost/users/cb/cran2deb/ unstable/all/' +MIRRORSITE='http://ftp.debian.org/debian/' +APTCACHE='' +PBUILDERSATISFYDEPENDSCMD='/usr/lib/pbuilder/pbuilder-satisfydepends-classic' -- 2.39.5