pkg/trunk/cran2deb

   1 #!/usr/bin/env r
   2
   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
  11
  12 # we cache the list of available packages
  13 load(file.path(root,'var/cache/available.cache.Rd'))
  14
  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
  18     pkgver = rver
  19
  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))
  24     }
  25
  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.'))
  31     }
  32
  33     # if rver contains a : then the Debian version must also have a colon
  34     if (debian_epoch == 0 && length(grep(':',pkgver)))
  35         debian_epoch = 1
  36
  37     # if the epoch is non-zero then include it
  38     if (debian_epoch != 0)
  39         pkgver = paste(debian_epoch,':',pkgver,sep='')
  40
  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=''))
  44 }
  45
  46 version.epoch <- function(pkgver) {
  47     # return the Debian epoch of a Debian package version
  48     if (!length(grep(':',pkgver)))
  49         return(0)
  50     return(as.integer(sub('^([0-9]+):.*','\\1',pkgver)))
  51 }
  52 # version.epoch . version.new(x,y) = id
  53 # version.epoch(version.new(x,y)) = 0
  54
  55 version.revision <- function(pkgver) {
  56     # return the Debian revision of a Debian package version
  57     return(as.integer(sub('.*-([0-9]+)$','\\1',pkgver)))
  58 }
  59 # version.revision . version.new(x) = id
  60 # version.revision(version.new(x)) = 1
  61
  62 version.upstream <- function(pkgver) {
  63     # return the upstream version of a Debian package version
  64     return(sub('-[0-9]+$','',sub('^[0-9]+:','',pkgver)))
  65 }
  66 # version.upstream . version.new = id
  67
  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)
  76                           ))
  77     }
  78     # new release
  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)
  83                       ))
  84 }
  85
  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'
  92
  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))) {
  96         return('cran')
  97     }
  98     if (length(grep('bioc',url))) {
  99         return('bioc')
 100     }
 101     stop(paste('unknown repository',url))
 102 }
 103
 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) {
 107         name = 'R'
 108     }
 109     if (name == 'R') {
 110         # R is special.
 111         if (binary) {
 112             debname='r-base-core'
 113         } else {
 114             debname='r-base-dev'
 115         }
 116     } else {
 117         # XXX: data.frame rownames are unique, so always override repopref for
 118         #      now.
 119         if (!(name %in% rownames(available))) {
 120             bundle <- r.bundle.of(name)
 121             if (is.na(bundle)) {
 122                 stop(paste('package',name,'is not available'))
 123             }
 124             name <- bundle
 125         }
 126         repopref <- repourl.as.debian(available[name,'Repository'])
 127         debname = paste('r',tolower(repopref),tolower(name),sep='-')
 128     }
 129     if (!is.null(version) && length(version) > 1) {
 130         debname = paste(debname,' (',version,')',sep='')
 131     }
 132     return(debname)
 133 }
 134
 135 setup <- function() {
 136     # set up the working directory
 137     tmp <- tempfile('cran2deb')
 138     dir.create(tmp)
 139     return (tmp)
 140 }
 141
 142 cleanup <- function(dir) {
 143     # remove the working directory
 144     unlink(dir,recursive=T)
 145     invisible()
 146 }
 147
 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)) {
 154             return(bundle)
 155         }
 156     }
 157     return(NA)
 158 }
 159
 160 r.bundle.contains <- function(bundlename) {
 161     return(strsplit(available[bundlename,'Contains'],'[[:space:]]+')[[1]])
 162 }
 163
 164 prepare.pkg <- function(dir, pkgname) {
 165     # download and extract an R package named pkgname
 166     # OR the bundle containing pkgname
 167
 168     # based loosely on library/utils/R/packages2.R::install.packages
 169     # should do nothing Debian specific
 170
 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)
 174         if (is.na(bundle)) {
 175             stop(paste('package',pkgname,'is unavailable'))
 176         }
 177         pkgname <- bundle
 178     }
 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))
 182     }
 183     wd <- getwd()
 184     setwd(dir)
 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))
 189     } else {
 190         stop(paste('Type of archive',archive,'is unknown.'))
 191     }
 192     ret = system(cmd)
 193     setwd(wd)
 194     if (ret != 0) {
 195         stop(paste('Extraction of archive',archive,'failed.'))
 196     }
 197     pkg <- pairlist()
 198     pkg$name = pkgname
 199     pkg$archive = archive
 200     pkg$path = sub("_\\.(zip|tar\\.gz)", ""
 201                   ,gsub(.standard_regexps()$valid_package_version, ""
 202                   ,archive))
 203     if (!file.info(pkg$path)[,'isdir']) {
 204         stop(paste(pkg$path,'is not a directory and should be.'))
 205     }
 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'))
 214     }
 215     return(pkg)
 216 }
 217
 218 debian_ok_licenses=c('GPL','LGPL','AGPL','ARTISTIC' #,'UNLIMITED'
 219                     ,'BSD','MIT','APACHE','X11','MPL')
 220
 221 is_acceptable_license <- function(license) {
 222     # determine if license is acceptable
 223
 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) {
 232         return(T)
 233     }
 234     # uninteresting urls
 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))
 242     # redundant
 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!'))
 253         return(T)
 254     }
 255     # remove everything that looks like a version specification
 256     license = gsub('(VER?SION|V)? *[0-9.-]+ *(OR *(HIGHER|LATER|NEWER|GREATER|ABOVE))?',''
 257                    ,license)
 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!'))
 262         return(T)
 263     }
 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'))
 267     return(F)
 268 }
 269
 270 chomp <- function(x) {
 271     # remove leading and trailing spaces
 272     return(sub('^[[:space:]]+','',sub('[[:space:]]+$','',x)))
 273 }
 274
 275 host.arch <- function() {
 276     # return the host system architecture
 277     system('dpkg-architecture -qDEB_HOST_ARCH',intern=T)
 278 }
 279
 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)) {
 283         return(data.frame())
 284     }
 285     if (is.null(description) && is.null(name)) {
 286         stop('must specify either a description or a name.')
 287     }
 288     if (is.null(description)) {
 289         if (!(name %in% rownames(available))) {
 290             bundle <- r.bundle.of(name)
 291             if (is.na(bundle)) {
 292                 stop(paste('package',name,'is not available'))
 293             }
 294             name <- bundle
 295         }
 296         description <- data.frame()
 297         # keep only the interesting fields
 298         for (field in r_depend_fields) {
 299             if (!(field %in% names(available[name,]))) {
 300                 next
 301             }
 302             description[1,field] = available[name,field]
 303         }
 304     }
 305     # extract the dependencies from the description
 306     deps <- data.frame()
 307     for (field in r_depend_fields) {
 308         if (!(field %in% names(description[1,]))) {
 309             next
 310         }
 311         for (dep in strsplit(chomp(description[1,field])
 312                                   ,'[[:space:]]*,[[:space:]]*')[[1]]) {
 313             if (is.na(dep)) {
 314                 # XXX: this may be a bug, but for some reason NA's appear in
 315                 #      this field at the end?
 316                 next
 317             }
 318             # remove other comments
 319             dep = gsub('(\\(\\)|\\([[:space:]]*[^<=>!].*\\))','',dep)
 320             # squish spaces
 321             dep = chomp(gsub('[[:space:]]+',' ',dep))
 322             # parse version
 323             pat = '^([^ ()]+) ?(\\( ?([<=>!]+ ?[0-9.-]+) ?\\))?$'
 324             if (!length(grep(pat,dep))) {
 325                 stop(paste('R dependency',dep,'does not appear to be well-formed'))
 326             }
 327             version = sub(pat,'\\3',dep)
 328             dep = sub(pat,'\\1',dep)
 329             if (!(dep %in% rownames(available))) {
 330                 depb <- r.bundle.of(dep)
 331                 if (!is.na(depb)) {
 332                     dep <- depb
 333                 }
 334             }
 335             deps <- rbind(deps,data.frame(list(name=dep
 336                                               ,version=version)))
 337         }
 338     }
 339     return (deps)
 340 }
 341
 342 r.dependency.closure <- function(fringe) {
 343     # find the transitive closure of the dependencies of some R packages
 344     closure <- list()
 345     if (is.data.frame(fringe)) {
 346         fringe <- levels(fringe$name)
 347     }
 348     while(length(fringe) > 0) {
 349         # pop off the top
 350         top <- fringe[[1]]
 351         if (length(fringe) > 1) {
 352             fringe <- fringe[2:length(fringe)]
 353         } else {
 354             fringe <- list()
 355         }
 356         src <- pkgname.as.debian(top,binary=F)
 357         if (!length(grep('^r-',src)) || length(grep('^r-base',src))) {
 358             next
 359         }
 360         newdeps <- levels(r.dependencies.of(name=top)$name)
 361         closure=c(closure,top)
 362         fringe=c(fringe,newdeps)
 363     }
 364     # build order
 365     return(rev(unique(closure,fromLast=T)))
 366 }
 367
 368 accept.license <- function(pkg) {
 369     # check the license
 370     if (!('License' %in% names(pkg$description[1,]))) {
 371         stop('package has no License: field in description!')
 372     }
 373     accept=NULL
 374     for (license in strsplit(chomp(pkg$description[1,'License'])
 375                             ,'[[:space:]]*\\|[[:space:]]*')[[1]]) {
 376         if (is_acceptable_license(license)) {
 377             accept=license
 378             break
 379         }
 380     }
 381     if (is.null(accept)) {
 382         stop(paste('No acceptable license:',pkg$description[1,'License']))
 383     } else {
 384         message(paste('N: Auto-accepted license',accept))
 385     }
 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)')
 390     }
 391     return(accept)
 392 }
 393
 394 get.dependencies <- function(pkg,extra_deps) {
 395     if ('SystemRequirements' %in% colnames(pkg$description)) {
 396         stop(paste('Unsupported SystemRequirements:',pkg$description[1,'SystemRequirements']))
 397     }
 398
 399     # determine dependencies
 400     dependencies <- r.dependencies.of(description=pkg$description)
 401     depends <- list()
 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
 406                                 ,repopref=pkg$repo
 407                                 ,binary=binary))
 408     }
 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)
 414
 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))
 419     }
 420
 421     # remove duplicates
 422     depends <- lapply(depends,unique)
 423
 424     # append the Debian dependencies
 425     depends$build=c(depends$build,'debhelper (>> 4.1.0)','cdbs')
 426     if (pkg$archdep) {
 427         depends$bin=c(depends$bin,'${shlibs:Depends}')
 428     }
 429
 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)
 433                       ,tolower)
 434     # append command line dependencies
 435     depends$r = c(extra_deps$r, depends$r)
 436     return(depends)
 437 }
 438
 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'))
 447 }
 448
 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'
 453              ,'',sep='\n')
 454        ,file=pkg$debfile('rules'))
 455     Sys.chmod(pkg$debfile('rules'),'0700')
 456 }
 457
 458 generate.copyright <- function(pkg) {
 459     # generate copyright file; we trust DESCRIPTION
 460     writeLines(strwrap(
 461         paste('This Debian package of the GNU R package',pkg$name
 462              ,'was generated automatically using cran2deb by'
 463              ,paste(maintainer,'.',sep='')
 464              ,''
 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.'
 470              ,''
 471              ,'The original GNU R package is maintained by'
 472              ,pkg$description[1,'Maintainer'],'and was obtained from:'
 473              ,''
 474              ,pkg$repoURL
 475              ,''
 476              ,''
 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/.'
 482              ,''
 483              ,'The DESCRIPTION file for the original GNU R package '
 484              ,'can be found in '
 485              ,file.path('/usr/lib/R/site-library'
 486                    ,pkg$debname
 487                    ,'DESCRIPTION'
 488                    )
 489              ,sep='\n'), width=72), con=pkg$debfile('copyright.in'))
 490 }
 491
 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'
 501
 502     control[2,'Package'] = pkg$debname
 503     control[2,'Architecture'] = 'all'
 504     if (pkg$archdep) {
 505         control[2,'Architecture'] = 'any'
 506     }
 507     control[2,'Depends'] = paste(pkg$depends$bin,collapse=', ')
 508
 509     # bundles provide virtual packages of their contents
 510     if (pkg$is_bundle) {
 511         control[2,'Provides'] = paste(
 512                     lapply(r.bundle.contains(pkg$name)
 513                           ,function(name) return(pkgname.as.debian(paste(name)
 514                                                                   ,repopref=pkg$repo
 515                                                                   ,binary=T)))
 516                           ,collapse=', ')
 517     }
 518
 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='')
 523     } else {
 524         descr = paste(descr,pkg$name,sep='')
 525     }
 526     if (pkg$is_bundle) {
 527         long_descr <- pkg$description[1,'BundleDescription']
 528     } else {
 529         long_descr <- pkg$description[1,'Description']
 530     }
 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='')
 537     }
 538     control[2,'Description'] = descr
 539
 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)
 543 }
 544
 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))
 551     }
 552     pkg$srcname = tolower(pkg$name)
 553     pkg$debname = pkgname.as.debian(pkg$name,repo=pkg$repo)
 554
 555     if (!length(grep('\\.tar\\.gz',pkg$archive))) {
 556         stop('archive is not tarball')
 557     }
 558
 559     # re-pack into a Debian-named archive with a Debian-named directory.
 560     debpath = file.path(dirname(pkg$archive)
 561                    ,paste(pkg$srcname,'-'
 562                          ,pkg$version
 563                          ,sep=''))
 564     file.rename(pkg$path, debpath)
 565     pkg$path = debpath
 566     debarchive = file.path(dirname(pkg$archive)
 567                           ,paste(pkg$srcname,'_'
 568                                 ,pkg$version,'.orig.tar.gz'
 569                                 ,sep=''))
 570     wd <- getwd()
 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 {} \\;'))
 575     # tar it all back up
 576     system(paste('tar -czf',shQuote(debarchive),shQuote(basename(pkg$path))))
 577     setwd(wd)
 578     file.remove(pkg$archive)
 579     pkg$archive = debarchive
 580
 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)
 585     dir.create(debdir)
 586
 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.
 594     if (pkg$is_bundle) {
 595         # if it's a bundle, check each of the packages
 596         pkg$archdep = F
 597         for (pkgname in r.bundle.contains(pkg$name)) {
 598             pkg$archdep = file.exists(file.path(pkg$path,pkgname,'src'))
 599             if (pkg$archdep) {
 600                 break
 601             }
 602         }
 603     } else {
 604         pkg$archdep = file.exists(file.path(pkg$path,'src'))
 605     }
 606     pkg$arch <- 'all'
 607     if (pkg$archdep) {
 608         pkg$arch <- host.arch()
 609     }
 610
 611     pkg$license <- accept.license(pkg)
 612     pkg$depends <- get.dependencies(pkg,extra_deps)
 613     generate.changelog(pkg)
 614     generate.rules(pkg)
 615     generate.copyright(pkg)
 616     generate.control(pkg)
 617
 618     # TODO: debian/watch from pkg$repoURL
 619
 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))
 624                     ,' -t utf8 '
 625                     ,shQuote(pkg$debfile(paste(file,'in',sep='.')))))
 626         file.remove(pkg$debfile(paste(file,'in',sep='.')))
 627     }
 628     return(pkg)
 629 }
 630
 631 build.debian <- function(pkg) {
 632     wd <- getwd()
 633     setwd(pkg$path)
 634     message(paste('N: building Debian package'
 635                  ,pkg$debname
 636                  ,paste('(',pkg$debversion,')',sep='')
 637                  ,'...'))
 638     ret = system(paste('pdebuild --configfile',pbuilder_config))
 639     setwd(wd)
 640     if (ret != 0) {
 641         stop('Failed to build package.')
 642     }
 643 }
 644
 645 changesfile <- function(srcname,version='*') {
 646     return(file.path(pbuilder_results
 647                     ,paste(srcname,'_',version,'_'
 648                           ,host.arch(),'.changes',sep='')))
 649 }
 650
 651 go <- function(name,extra_deps) {
 652     dir <- setup()
 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))
 657             return(pkg)
 658         }
 659
 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)
 665             }
 666         }
 667
 668         # delete notes of upload
 669         file.remove(Sys.glob(file.path(pbuilder_results,'*.upload')))
 670
 671         # make mini-dinstall generate the skeleton of the archive
 672         ret = system(paste('umask 022;mini-dinstall --batch -c',dinstall_config))
 673         if (ret != 0) {
 674             stop('failed to create archive')
 675         }
 676
 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'
 682                         ,changesfile(dep)))
 683             if (ret != 0) {
 684                 stop('upload of dependency failed! maybe you did not build it first?')
 685             }
 686         }
 687         build.debian(pkg)
 688
 689         # upload the package
 690         ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local'
 691                     ,changesfile(pkg$srcname,pkg$debversion)))
 692         if (ret != 0) {
 693             stop('upload failed!')
 694         }
 695
 696         return(pkg)
 697     })())
 698     cleanup(dir)
 699     if (inherits(pkg,'try-error')) {
 700         stop(call.=F)
 701     }
 702     return(pkg)
 703 }
 704
 705 if (exists('argv')) { # check for littler
 706     argc <- length(argv)
 707     extra_deps = list()
 708     extra_deps$deb = c()
 709     extra_deps$r = c()
 710     opts = c('-D','-R')
 711     for (i in 1:argc) {
 712         if (!(argv[i] %in% opts)) {
 713             if (argc >= i) {
 714                 argv <- argv[i:argc]
 715             } else {
 716                 argv <- list()
 717             }
 718             argc = argc - i + 1
 719             break
 720         }
 721         if (i == argc) {
 722             message('E: missing argument')
 723             q(save='no')
 724         }
 725         if (argv[i] == '-D') {
 726             extra_deps$deb = c(extra_deps$deb,strsplit(chomp(argv[i+1]),',')[[1]])
 727         }
 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))
 731         }
 732     }
 733     if (argc == 0) {
 734         message('E: usage: cran2deb [-D extra_dep1,extra_dep2,...] package package ...')
 735         q(save='no')
 736     }
 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) {
 740         go(pkg,extra_deps)
 741     }
 742 }