3 maintainer <- 'cran2deb buildbot <cran2deb@example.org>'
4 root <- '/home/cb/work/gsoc/cran2deb'
5 pbuilder_results <- file.path(root,'var/results')
6 pbuilder_config <- file.path(root,'etc/pbuilderrc')
7 dput_config <- file.path(root,'etc/dput.cf')
8 dinstall_config <- file.path(root,'etc/mini-dinstall.conf')
9 dinstall_archive <- file.path(root,'var/archive')
10 r_depend_fields <- c('Depends','Imports') # Suggests, Enhances
12 # we cache the list of available packages
13 load(file.path(root,'var/cache/available.cache.Rd'))
15 version.new <- function(rver,debian_revision=1, debian_epoch=0) {
16 # generate a string representation of the Debian version of an
17 # R version of a package
20 # ``Writing R extensions'' says that the version consists of at least two
21 # non-negative integers, separated by . or -
22 if (!length(grep('^([0-9]+[.-])+[0-9]+$',rver))) {
23 stop(paste('Not a valid R package version',rver))
26 # Debian policy says that an upstream version should start with a digit and
27 # may only contain ASCII alphanumerics and '.+-:~'
28 if (!length(grep('^[0-9][A-Za-z0-9.+:~-]*$',rver))) {
29 stop(paste('R package version',rver
30 ,'does not obviously translate into a valid Debian version.'))
33 # if rver contains a : then the Debian version must also have a colon
34 if (debian_epoch == 0 && length(grep(':',pkgver)))
37 # if the epoch is non-zero then include it
38 if (debian_epoch != 0)
39 pkgver = paste(debian_epoch,':',pkgver,sep='')
41 # always add the '-1' Debian release; nothing is lost and rarely will R
42 # packages be Debian packages without modification.
43 return(paste(pkgver,'-',debian_revision,sep=''))
46 version.epoch <- function(pkgver) {
47 # return the Debian epoch of a Debian package version
48 if (!length(grep(':',pkgver)))
50 return(as.integer(sub('^([0-9]+):.*','\\1',pkgver)))
52 # version.epoch . version.new(x,y) = id
53 # version.epoch(version.new(x,y)) = 0
55 version.revision <- function(pkgver) {
56 # return the Debian revision of a Debian package version
57 return(as.integer(sub('.*-([0-9]+)$','\\1',pkgver)))
59 # version.revision . version.new(x) = id
60 # version.revision(version.new(x)) = 1
62 version.upstream <- function(pkgver) {
63 # return the upstream version of a Debian package version
64 return(sub('-[0-9]+$','',sub('^[0-9]+:','',pkgver)))
66 # version.upstream . version.new = id
68 version.update <- function(rver, prev_pkgver) {
69 # return the next debian package version
70 prev_rver <- version.upstream(prev_pkgver)
71 if (prev_rver == rver) {
72 # increment the Debian revision
73 return(version.new(rver
74 ,debian_revision = version.revision(prev_pkgver)+1
75 ,debian_epoch = version.epoch(prev_pkgver)
79 # TODO: implement Debian ordering over version and then autoincrement
80 # Debian epoch when upstream version does not increment.
81 return(version.new(rver
82 ,debian_epoch = version.epoch(prev_pkgver)
86 # sudo pbuilder --execute r -e 'rownames(installed.packages())'
87 # XXX: has to be a better way of doing this
88 base_pkgs=c('base', 'datasets','grDevices','graphics','grid', 'methods'
89 ,'splines','stats', 'stats4', 'tcltk', 'tools','utils')
90 # found in R source directory:
91 # 'profile', 'datasets'
93 repourl.as.debian <- function(url) {
94 # map the url to a repository onto its name in debian package naming
95 if (length(grep('cran',url))) {
98 if (length(grep('bioc',url))) {
101 stop(paste('unknown repository',url))
104 pkgname.as.debian <- function(name,repopref=NULL,version=NULL,binary=T) {
105 # generate the debian package name corresponding to the R package name
106 if (name %in% base_pkgs) {
112 debname='r-base-core'
117 # XXX: data.frame rownames are unique, so always override repopref for
119 if (!(name %in% rownames(available))) {
120 bundle <- r.bundle.of(name)
122 stop(paste('package',name,'is not available'))
126 repopref <- repourl.as.debian(available[name,'Repository'])
127 debname = paste('r',tolower(repopref),tolower(name),sep='-')
129 if (!is.null(version) && length(version) > 1) {
130 debname = paste(debname,' (',version,')',sep='')
135 setup <- function() {
136 # set up the working directory
137 tmp <- tempfile('cran2deb')
142 cleanup <- function(dir) {
143 # remove the working directory
144 unlink(dir,recursive=T)
148 r.bundle.of <- function(pkgname) {
149 # returns the bundle containing pkgname or NA
150 bundles <- names(available[!is.na(available[, 'Bundle']), 'Contains'])
151 # use the first bundle
152 for (bundle in bundles) {
153 if (pkgname %in% r.bundle.contains(bundle)) {
160 r.bundle.contains <- function(bundlename) {
161 return(strsplit(available[bundlename,'Contains'],'[[:space:]]+')[[1]])
164 prepare.pkg <- function(dir, pkgname) {
165 # download and extract an R package named pkgname
166 # OR the bundle containing pkgname
168 # based loosely on library/utils/R/packages2.R::install.packages
169 # should do nothing Debian specific
171 # first a little trick; change pkgname if pkgname is contained in a bundle
172 if (!(pkgname %in% rownames(available))) {
173 bundle <- r.bundle.of(pkgname)
175 stop(paste('package',pkgname,'is unavailable'))
179 archive <- download.packages(pkgname, dir, available=available, repos='', type="source")[1,2]
180 if (length(grep('\\.\\.',archive)) || normalizePath(archive) != archive) {
181 stop(paste('funny looking path',archive))
185 if (length(grep('\\.zip$',archive))) {
186 cmd = paste('unzip',shQuote(archive))
187 } else if (length(grep('\\.tar\\.gz$',archive))) {
188 cmd = paste('tar','xzf',shQuote(archive))
190 stop(paste('Type of archive',archive,'is unknown.'))
195 stop(paste('Extraction of archive',archive,'failed.'))
199 pkg$archive = archive
200 pkg$path = sub("_\\.(zip|tar\\.gz)", ""
201 ,gsub(.standard_regexps()$valid_package_version, ""
203 if (!file.info(pkg$path)[,'isdir']) {
204 stop(paste(pkg$path,'is not a directory and should be.'))
206 pkg$description = read.dcf(file.path(pkg$path,'DESCRIPTION'))
207 pkg$repoURL = available[pkgname,'Repository']
208 pkg$version = pkg$description[1,'Version']
209 pkg$is_bundle = 'Bundle' %in% names(pkg$description[1,])
210 # note subtly of short circuit operators (no absorption)
211 if ((!pkg$is_bundle && pkg$description[1,'Package'] != pkg$name) ||
212 ( pkg$is_bundle && pkg$description[1,'Bundle'] != pkg$name)) {
213 stop(paste('package name mismatch'))
218 debian_ok_licenses=c('GPL','LGPL','AGPL','ARTISTIC' #,'UNLIMITED'
219 ,'BSD','MIT','APACHE','X11','MPL')
221 is_acceptable_license <- function(license) {
222 # determine if license is acceptable
224 # compress spaces into a single space
225 license = gsub('[[:blank:]]+',' ',license)
226 # make all characters upper case
227 license = toupper(license)
228 # don't care about versions of licenses
229 license = chomp(sub('\\( ?[<=>!]+ ?[0-9.-]+ ?\\)',''
230 ,sub('-[0-9.-]+','',license)))
231 if (license %in% debian_ok_licenses) {
235 license = gsub('HTTP://WWW.GNU.ORG/[A-Z/._-]*','',license)
236 license = gsub('HTTP://WWW.X.ORG/[A-Z/._-]*','',license)
237 license = gsub('HTTP://WWW.OPENSOURCE.ORG/[A-Z/._-]*','',license)
238 # remove all punctuation
239 license = gsub('[[:punct:]]+','',license)
240 # remove any extra space introduced
241 license = chomp(gsub('[[:space:]]+',' ',license))
243 license = gsub('THE','',license)
244 license = gsub('SEE','',license)
245 license = gsub('STANDARD','',license)
246 license = gsub('LICEN[SC]E','',license)
247 license = gsub('(GNU )?(GPL|GENERAL PUBLIC)','GPL',license)
248 license = gsub('(MOZILLA )?(MPL|MOZILLA PUBLIC)','MPL',license)
249 # remove any extra space introduced
250 license = chomp(gsub('[[:space:]]+',' ',license))
251 if (license %in% debian_ok_licenses) {
252 message(paste('W: Accepted wild license as',license,'. FIX THE PACKAGE!'))
255 # remove everything that looks like a version specification
256 license = gsub('(VER?SION|V)? *[0-9.-]+ *(OR *(HIGHER|LATER|NEWER|GREATER|ABOVE))?',''
258 # remove any extra space introduced
259 license = chomp(gsub('[[:space:]]+',' ',license))
260 if (license %in% debian_ok_licenses) {
261 message(paste('W: Accepted wild license as',license,'. FIX THE PACKAGE!'))
264 # TODO: put debian_ok_licenses in DB
265 # TODO: file {LICENSE,LICENCE} (+ maybe COPYING?)
266 message(paste('E: Wild license',license,'did not match'))
270 chomp <- function(x) {
271 # remove leading and trailing spaces
272 return(sub('^[[:space:]]+','',sub('[[:space:]]+$','',x)))
275 host.arch <- function() {
276 # return the host system architecture
277 system('dpkg-architecture -qDEB_HOST_ARCH',intern=T)
280 r.dependencies.of <- function(name=NULL,description=NULL) {
281 # find the immediate dependencies of an R package
282 if (!is.null(name) && (name == 'R' || name %in% base_pkgs)) {
285 if (is.null(description) && is.null(name)) {
286 stop('must specify either a description or a name.')
288 if (is.null(description)) {
289 if (!(name %in% rownames(available))) {
290 bundle <- r.bundle.of(name)
292 stop(paste('package',name,'is not available'))
296 description <- data.frame()
297 # keep only the interesting fields
298 for (field in r_depend_fields) {
299 if (!(field %in% names(available[name,]))) {
302 description[1,field] = available[name,field]
305 # extract the dependencies from the description
307 for (field in r_depend_fields) {
308 if (!(field %in% names(description[1,]))) {
311 for (dep in strsplit(chomp(description[1,field])
312 ,'[[:space:]]*,[[:space:]]*')[[1]]) {
314 # XXX: this may be a bug, but for some reason NA's appear in
315 # this field at the end?
318 # remove other comments
319 dep = gsub('(\\(\\)|\\([[:space:]]*[^<=>!].*\\))','',dep)
321 dep = chomp(gsub('[[:space:]]+',' ',dep))
323 pat = '^([^ ()]+) ?(\\( ?([<=>!]+ ?[0-9.-]+) ?\\))?$'
324 if (!length(grep(pat,dep))) {
325 stop(paste('R dependency',dep,'does not appear to be well-formed'))
327 version = sub(pat,'\\3',dep)
328 dep = sub(pat,'\\1',dep)
329 if (!(dep %in% rownames(available))) {
330 depb <- r.bundle.of(dep)
335 deps <- rbind(deps,data.frame(list(name=dep
342 r.dependency.closure <- function(fringe) {
343 # find the transitive closure of the dependencies of some R packages
345 if (is.data.frame(fringe)) {
346 fringe <- levels(fringe$name)
348 while(length(fringe) > 0) {
351 if (length(fringe) > 1) {
352 fringe <- fringe[2:length(fringe)]
356 src <- pkgname.as.debian(top,binary=F)
357 if (!length(grep('^r-',src)) || length(grep('^r-base',src))) {
360 newdeps <- levels(r.dependencies.of(name=top)$name)
361 closure=c(closure,top)
362 fringe=c(fringe,newdeps)
365 return(rev(unique(closure,fromLast=T)))
368 accept.license <- function(pkg) {
370 if (!('License' %in% names(pkg$description[1,]))) {
371 stop('package has no License: field in description!')
374 for (license in strsplit(chomp(pkg$description[1,'License'])
375 ,'[[:space:]]*\\|[[:space:]]*')[[1]]) {
376 if (is_acceptable_license(license)) {
381 if (is.null(accept)) {
382 stop(paste('No acceptable license:',pkg$description[1,'License']))
384 message(paste('N: Auto-accepted license',accept))
386 if (accept == 'Unlimited') {
387 # definition of Unlimited from ``Writing R extensions''
388 accept=paste('Unlimited (no restrictions on distribution or'
389 ,'use other than those imposed by relevant laws)')
394 get.dependencies <- function(pkg,extra_deps) {
395 if ('SystemRequirements' %in% colnames(pkg$description)) {
396 stop(paste('Unsupported SystemRequirements:',pkg$description[1,'SystemRequirements']))
399 # determine dependencies
400 dependencies <- r.dependencies.of(description=pkg$description)
402 # these are used for generating the Depends fields
403 as.deb <- function(r,binary) {
404 return(pkgname.as.debian(paste(dependencies[r,]$name)
405 ,version=dependencies[r,]$version
409 depends$bin <- lapply(rownames(dependencies), as.deb, binary=T)
410 depends$build <- lapply(rownames(dependencies), as.deb, binary=F)
411 # add the command line dependencies
412 depends$bin = c(extra_deps$deb,depends$bin)
413 depends$build = c(extra_deps$deb,depends$build)
415 # make sure we depend upon R in some way...
416 if (!length(grep('^r-base',depends$build))) {
417 depends$build = c(depends$build,pkgname.as.debian('R',version='>= 2.7.0',binary=F))
418 depends$bin = c(depends$bin, pkgname.as.debian('R',version='>= 2.7.0',binary=T))
422 depends <- lapply(depends,unique)
424 # append the Debian dependencies
425 depends$build=c(depends$build,'debhelper (>> 4.1.0)','cdbs')
427 depends$bin=c(depends$bin,'${shlibs:Depends}')
430 # the names of dependent source packages (to find the .changes file to
431 # upload via dput). these can be found recursively.
432 depends$r = lapply(r.dependency.closure(dependencies)
434 # append command line dependencies
435 depends$r = c(extra_deps$r, depends$r)
439 generate.changelog <- function(pkg) {
440 # construct a dummy changelog
441 # TODO: ``Writing R extensions'' mentions that a package may also have
442 # {NEWS,ChangeLog} files.
443 cat(paste(paste(pkg$srcname,' (',pkg$debversion,') unstable; urgency=low',sep='')
444 ,'' ,' * Initial release.',''
445 ,paste(' --',maintainer,'',format(Sys.time(),'%a, %d %b %Y %H:%M:%S %z'))
446 ,'',sep='\n'),file=pkg$debfile('changelog.in'))
449 generate.rules <- function(pkg) {
450 cat(paste('#!/usr/bin/make -f'
451 ,paste('debRreposname :=',pkg$repo)
452 ,'include /usr/share/R/debian/r-cran.mk'
454 ,file=pkg$debfile('rules'))
455 Sys.chmod(pkg$debfile('rules'),'0700')
458 generate.copyright <- function(pkg) {
459 # generate copyright file; we trust DESCRIPTION
461 paste('This Debian package of the GNU R package',pkg$name
462 ,'was generated automatically using cran2deb by'
463 ,paste(maintainer,'.',sep='')
465 ,'The original GNU R package is Copyright (C) '
466 # TODO: copyright start date, true copyright date
467 ,format(Sys.time(),'%Y')
468 ,pkg$description[1,'Author']
469 ,'and possibly others.'
471 ,'The original GNU R package is maintained by'
472 ,pkg$description[1,'Maintainer'],'and was obtained from:'
477 ,'The GNU R package DESCRIPTION offers a'
478 ,'Copyright licenses under the terms of the',pkg$license
479 ,'license. On a Debian GNU/Linux system, common'
480 ,'licenses are included in the directory'
481 ,'/usr/share/common-licenses/.'
483 ,'The DESCRIPTION file for the original GNU R package '
485 ,file.path('/usr/lib/R/site-library'
489 ,sep='\n'), width=72), con=pkg$debfile('copyright.in'))
492 generate.control <- function(pkg) {
493 # construct control file
494 control = data.frame()
495 control[1,'Source'] = pkg$srcname
496 control[1,'Section'] = 'math'
497 control[1,'Priority'] = 'optional'
498 control[1,'Maintainer'] = maintainer
499 control[1,'Build-Depends'] = paste(pkg$depends$build,collapse=', ')
500 control[1,'Standards-Version'] = '3.8.0'
502 control[2,'Package'] = pkg$debname
503 control[2,'Architecture'] = 'all'
505 control[2,'Architecture'] = 'any'
507 control[2,'Depends'] = paste(pkg$depends$bin,collapse=', ')
509 # bundles provide virtual packages of their contents
511 control[2,'Provides'] = paste(
512 lapply(r.bundle.contains(pkg$name)
513 ,function(name) return(pkgname.as.debian(paste(name)
519 # generate the description
520 descr = 'GNU R package "'
521 if ('Title' %in% colnames(pkg$description)) {
522 descr = paste(descr,pkg$description[1,'Title'],sep='')
524 descr = paste(descr,pkg$name,sep='')
527 long_descr <- pkg$description[1,'BundleDescription']
529 long_descr <- pkg$description[1,'Description']
531 # using \n\n.\n\n is not very nice, but is necessary to make sure
532 # the longer description does not begin on the synopsis line --- R's
533 # write.dcf does not appear to have a nicer way of doing this.
534 descr = paste(descr,'"\n\n', long_descr, sep='')
535 if ('URL' %in% colnames(pkg$description)) {
536 descr = paste(descr,'\n\nURL: ',pkg$description[1,'URL'],sep='')
538 control[2,'Description'] = descr
540 # Debian policy says 72 char width; indent minimally
541 write.dcf(control,file=pkg$debfile('control.in'),indent=1,width=72)
542 write.dcf(control,indent=1,width=72)
545 prepare.new.debian <- function(pkg,extra_deps) {
546 # generate Debian version and name
547 pkg$repo = repourl.as.debian(pkg$repoURL)
548 pkg$debversion = version.new(pkg$version)
549 if (!length(grep('^[A-Za-z0-9][A-Za-z0-9+.-]+$',pkg$name))) {
550 stop(paste('Cannot convert package name into a Debian name',pkg$name))
552 pkg$srcname = tolower(pkg$name)
553 pkg$debname = pkgname.as.debian(pkg$name,repo=pkg$repo)
555 if (!length(grep('\\.tar\\.gz',pkg$archive))) {
556 stop('archive is not tarball')
559 # re-pack into a Debian-named archive with a Debian-named directory.
560 debpath = file.path(dirname(pkg$archive)
561 ,paste(pkg$srcname,'-'
564 file.rename(pkg$path, debpath)
566 debarchive = file.path(dirname(pkg$archive)
567 ,paste(pkg$srcname,'_'
568 ,pkg$version,'.orig.tar.gz'
571 setwd(dirname(pkg$path))
572 # remove them pesky +x files
573 system(paste('find',shQuote(basename(pkg$path))
574 ,'-type f -exec chmod -x {} \\;'))
576 system(paste('tar -czf',shQuote(debarchive),shQuote(basename(pkg$path))))
578 file.remove(pkg$archive)
579 pkg$archive = debarchive
581 # make the debian/ directory
582 debdir <- file.path(pkg$path,'debian')
583 pkg$debfile <- function(x) { file.path(debdir,x) }
584 unlink(debdir,recursive=T)
587 # see if this is an architecture-dependent package.
588 # heuristic: if /src/ exists in pkg$path, then this is an
589 # architecture-dependent package.
590 # CRAN2DEB.pm is a bit fancier about this but ``Writing R extensions''
591 # says: ``The sources and headers for the compiled code are in src, plus
592 # optionally file Makevars or Makefile.'' It seems unlikely that
593 # architecture independent code would end up here.
595 # if it's a bundle, check each of the packages
597 for (pkgname in r.bundle.contains(pkg$name)) {
598 pkg$archdep = file.exists(file.path(pkg$path,pkgname,'src'))
604 pkg$archdep = file.exists(file.path(pkg$path,'src'))
608 pkg$arch <- host.arch()
611 pkg$license <- accept.license(pkg)
612 pkg$depends <- get.dependencies(pkg,extra_deps)
613 generate.changelog(pkg)
615 generate.copyright(pkg)
616 generate.control(pkg)
618 # TODO: debian/watch from pkg$repoURL
620 # convert text to utf8 (who knows what the original character set is --
621 # let's hope iconv DTRT).
622 for (file in c('control','changelog','copyright')) {
623 system(paste('iconv -o ',shQuote(pkg$debfile(file))
625 ,shQuote(pkg$debfile(paste(file,'in',sep='.')))))
626 file.remove(pkg$debfile(paste(file,'in',sep='.')))
631 build.debian <- function(pkg) {
634 message(paste('N: building Debian package'
636 ,paste('(',pkg$debversion,')',sep='')
638 ret = system(paste('pdebuild --configfile',pbuilder_config))
641 stop('Failed to build package.')
645 changesfile <- function(srcname,version='*') {
646 return(file.path(pbuilder_results
647 ,paste(srcname,'_',version,'_'
648 ,host.arch(),'.changes',sep='')))
651 go <- function(name,extra_deps) {
653 pkg <- try((function() {
654 pkg <- prepare.new.debian(prepare.pkg(dir,name),extra_deps)
655 if (file.exists(changesfile(pkg$srcname,pkg$debversion))) {
656 message(paste('N: already built',pkg$srcname,'version',pkg$debversion))
660 # delete the current archive (XXX: assumes mini-dinstall)
661 for (subdir in c('mini-dinstall','unstable')) {
662 path = file.path(dinstall_archive,subdir)
663 if (file.exists(path)) {
664 unlink(path,recursive=T)
668 # delete notes of upload
669 file.remove(Sys.glob(file.path(pbuilder_results,'*.upload')))
671 # make mini-dinstall generate the skeleton of the archive
672 ret = system(paste('umask 022;mini-dinstall --batch -c',dinstall_config))
674 stop('failed to create archive')
677 # pull in all the R dependencies
678 message(paste('N: dependencies:',paste(pkg$depends$r,collapse=', ')))
679 for (dep in pkg$depends$r) {
680 message(paste('N: uploading',dep))
681 ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local'
684 stop('upload of dependency failed! maybe you did not build it first?')
690 ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local'
691 ,changesfile(pkg$srcname,pkg$debversion)))
693 stop('upload failed!')
699 if (inherits(pkg,'try-error')) {
705 if (exists('argv')) { # check for littler
712 if (!(argv[i] %in% opts)) {
722 message('E: missing argument')
725 if (argv[i] == '-D') {
726 extra_deps$deb = c(extra_deps$deb,strsplit(chomp(argv[i+1]),',')[[1]])
728 if (argv[i] == '-R') {
729 extra_deps$r = c(extra_deps$r,strsplit(chomp(argv[i+1]),',')[[1]])
730 extra_deps$deb = c(extra_deps$deb,lapply(extra_deps$r,pkgname.as.debian))
734 message('E: usage: cran2deb [-D extra_dep1,extra_dep2,...] package package ...')
737 build_order <- r.dependency.closure(c(extra_deps$r,argv))
738 message(paste('N: build order',paste(build_order,collapse=', ')))
739 for (pkg in build_order) {