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 iterate <- function(xs,z,fun) {
 271     y <- z
 272     for (x in xs)
 273         y <- fun(y,x)
 274     return(y)
 275 }
 276
 277 chomp <- function(x) {
 278     # remove leading and trailing spaces
 279     return(sub('^[[:space:]]+','',sub('[[:space:]]+$','',x)))
 280 }
 281
 282 host.arch <- function() {
 283     # return the host system architecture
 284     system('dpkg-architecture -qDEB_HOST_ARCH',intern=T)
 285 }
 286
 287 r.requiring <- function(names) {
 288     for (name in names) {
 289         if (!(name %in% base_pkgs) && !(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             names <- c(names,r.bundle.contains(bundle))
 295         }
 296     }
 297     # approximately prune first into a smaller availability
 298     candidates <- available[sapply(rownames(available)
 299                                   ,function(name)
 300                                       length(grep(paste(names,sep='|')
 301                                                  ,available[name,r_depend_fields])) > 0)
 302                            ,r_depend_fields
 303                            ,drop=F]
 304     if (length(candidates) == 0) {
 305         return(c())
 306     }
 307     # find a logical index into available of every package/bundle
 308     # whose dependency field contains at least one element of names.
 309     # (this is not particularly easy to read---sorry---but is much faster than
 310     # the alternatives i could think of)
 311     prereq=c()
 312     dep_matches <- function(dep) chomp(gsub('\\([^\\)]+\\)','',dep)) %in% names
 313     any_dep_matches <- function(name,field=NA)
 314                 any(sapply(strsplit(chomp(candidates[name,field])
 315                                    ,'[[:space:]]*,[[:space:]]*')
 316                           ,dep_matches))
 317
 318     for (field in r_depend_fields) {
 319         matches = sapply(rownames(candidates), any_dep_matches, field=field)
 320         if (length(matches) > 0) {
 321             prereq = c(prereq,rownames(candidates[matches,]))
 322         }
 323     }
 324     return(unique(prereq))
 325 }
 326
 327 r.dependencies.of <- function(name=NULL,description=NULL) {
 328     # find the immediate dependencies (children in the dependency graph) of an
 329     # R package
 330     if (!is.null(name) && (name == 'R' || name %in% base_pkgs)) {
 331         return(data.frame())
 332     }
 333     if (is.null(description) && is.null(name)) {
 334         stop('must specify either a description or a name.')
 335     }
 336     if (is.null(description)) {
 337         if (!(name %in% rownames(available))) {
 338             bundle <- r.bundle.of(name)
 339             if (is.na(bundle)) {
 340                 stop(paste('package',name,'is not available'))
 341             }
 342             name <- bundle
 343         }
 344         description <- data.frame()
 345         # keep only the interesting fields
 346         for (field in r_depend_fields) {
 347             if (!(field %in% names(available[name,]))) {
 348                 next
 349             }
 350             description[1,field] = available[name,field]
 351         }
 352     }
 353     # extract the dependencies from the description
 354     deps <- data.frame()
 355     for (field in r_depend_fields) {
 356         if (!(field %in% names(description[1,]))) {
 357             next
 358         }
 359         new_deps <- lapply(strsplit(chomp(description[1,field])
 360                                    ,'[[:space:]]*,[[:space:]]*')[[1]]
 361                           ,r.parse.dep.field)
 362         deps <- iterate(lapply(new_deps[!is.na(new_deps)],rbind),deps,rbind)
 363     }
 364     return (deps)
 365 }
 366
 367 r.parse.dep.field <- function(dep) {
 368     if (is.na(dep)) {
 369         return(NA)
 370     }
 371     # remove other comments
 372     dep = gsub('(\\(\\)|\\([[:space:]]*[^<=>!].*\\))','',dep)
 373     # squish spaces
 374     dep = chomp(gsub('[[:space:]]+',' ',dep))
 375     # parse version
 376     pat = '^([^ ()]+) ?(\\( ?([<=>!]+ ?[0-9.-]+) ?\\))?$'
 377     if (!length(grep(pat,dep))) {
 378         stop(paste('R dependency',dep,'does not appear to be well-formed'))
 379     }
 380     version = sub(pat,'\\3',dep)
 381     dep = sub(pat,'\\1',dep)
 382     if (!(dep %in% rownames(available))) {
 383         depb <- r.bundle.of(dep)
 384         if (!is.na(depb)) {
 385             dep <- depb
 386         }
 387     }
 388     return(list(name=dep,version=version))
 389 }
 390
 391 r.dependency.closure <- function(fringe, forward_arcs=T) {
 392     # find the transitive closure of the dependencies/prerequisites of some R
 393     # packages
 394     closure <- list()
 395     if (is.data.frame(fringe)) {
 396         fringe <- levels(fringe$name)
 397     }
 398     fun = function(x) levels(r.dependencies.of(name=x)$name)
 399     if (!forward_arcs) {
 400         fun = r.requiring
 401     }
 402     while(length(fringe) > 0) {
 403         # pop off the top
 404         top <- fringe[[1]]
 405         if (length(fringe) > 1) {
 406             fringe <- fringe[2:length(fringe)]
 407         } else {
 408             fringe <- list()
 409         }
 410         src <- pkgname.as.debian(top,binary=F)
 411         if (!length(grep('^r-',src)) || length(grep('^r-base',src))) {
 412             next
 413         }
 414         newdeps <- fun(top)
 415         closure=c(closure,top)
 416         fringe=c(fringe,newdeps)
 417     }
 418     # build order
 419     return(rev(unique(closure,fromLast=T)))
 420 }
 421
 422 accept.license <- function(pkg) {
 423     # check the license
 424     if (!('License' %in% names(pkg$description[1,]))) {
 425         stop('package has no License: field in description!')
 426     }
 427     accept=NULL
 428     for (license in strsplit(chomp(pkg$description[1,'License'])
 429                             ,'[[:space:]]*\\|[[:space:]]*')[[1]]) {
 430         if (is_acceptable_license(license)) {
 431             accept=license
 432             break
 433         }
 434     }
 435     if (is.null(accept)) {
 436         stop(paste('No acceptable license:',pkg$description[1,'License']))
 437     } else {
 438         message(paste('N: Auto-accepted license',accept))
 439     }
 440     if (accept == 'Unlimited') {
 441         # definition of Unlimited from ``Writing R extensions''
 442         accept=paste('Unlimited (no restrictions on distribution or'
 443                     ,'use other than those imposed by relevant laws)')
 444     }
 445     return(accept)
 446 }
 447
 448 get.dependencies <- function(pkg,extra_deps) {
 449     if ('SystemRequirements' %in% colnames(pkg$description)) {
 450         stop(paste('Unsupported SystemRequirements:',pkg$description[1,'SystemRequirements']))
 451     }
 452
 453     # determine dependencies
 454     dependencies <- r.dependencies.of(description=pkg$description)
 455     depends <- list()
 456     # these are used for generating the Depends fields
 457     as.deb <- function(r,binary) {
 458         return(pkgname.as.debian(paste(dependencies[r,]$name)
 459                                 ,version=dependencies[r,]$version
 460                                 ,repopref=pkg$repo
 461                                 ,binary=binary))
 462     }
 463     depends$bin <- lapply(rownames(dependencies), as.deb, binary=T)
 464     depends$build <- lapply(rownames(dependencies), as.deb, binary=F)
 465     # add the command line dependencies
 466     depends$bin = c(extra_deps$deb,depends$bin)
 467     depends$build = c(extra_deps$deb,depends$build)
 468
 469     # make sure we depend upon R in some way...
 470     if (!length(grep('^r-base',depends$build))) {
 471         depends$build = c(depends$build,pkgname.as.debian('R',version='>= 2.7.0',binary=F))
 472         depends$bin   = c(depends$bin,  pkgname.as.debian('R',version='>= 2.7.0',binary=T))
 473     }
 474     # also include stuff to allow tcltk to build (suggested by Dirk)
 475     depends$build = c(depends$build,'xvfb','xauth','xfont-base')
 476
 477     # remove duplicates
 478     depends <- lapply(depends,unique)
 479
 480     # append the Debian dependencies
 481     depends$build=c(depends$build,'debhelper (>> 4.1.0)','cdbs')
 482     if (pkg$archdep) {
 483         depends$bin=c(depends$bin,'${shlibs:Depends}')
 484     }
 485
 486     # the names of dependent source packages (to find the .changes file to
 487     # upload via dput). these can be found recursively.
 488     depends$r = lapply(r.dependency.closure(dependencies)
 489                       ,tolower)
 490     # append command line dependencies
 491     depends$r = c(extra_deps$r, depends$r)
 492     return(depends)
 493 }
 494
 495 generate.changelog <- function(pkg) {
 496     # construct a dummy changelog
 497     # TODO: ``Writing R extensions'' mentions that a package may also have
 498     # {NEWS,ChangeLog} files.
 499     cat(paste(paste(pkg$srcname,' (',pkg$debversion,') unstable; urgency=low',sep='')
 500              ,'' ,'  * Initial release.',''
 501              ,paste(' --',maintainer,'',format(Sys.time(),'%a, %d %b %Y %H:%M:%S %z'))
 502              ,'',sep='\n'),file=pkg$debfile('changelog.in'))
 503 }
 504
 505 generate.rules <- function(pkg) {
 506     cat(paste('#!/usr/bin/make -f'
 507              ,paste('debRreposname :=',pkg$repo)
 508              ,'include /usr/share/R/debian/r-cran.mk'
 509              ,'',sep='\n')
 510        ,file=pkg$debfile('rules'))
 511     Sys.chmod(pkg$debfile('rules'),'0700')
 512 }
 513
 514 generate.copyright <- function(pkg) {
 515     # generate copyright file; we trust DESCRIPTION
 516     writeLines(strwrap(
 517         paste('This Debian package of the GNU R package',pkg$name
 518              ,'was generated automatically using cran2deb by'
 519              ,paste(maintainer,'.',sep='')
 520              ,''
 521              ,'The original GNU R package is Copyright (C) '
 522              # TODO: copyright start date, true copyright date
 523              ,format(Sys.time(),'%Y')
 524              ,pkg$description[1,'Author']
 525              ,'and possibly others.'
 526              ,''
 527              ,'The original GNU R package is maintained by'
 528              ,pkg$description[1,'Maintainer'],'and was obtained from:'
 529              ,''
 530              ,pkg$repoURL
 531              ,''
 532              ,''
 533              ,'The GNU R package DESCRIPTION offers a'
 534              ,'Copyright licenses under the terms of the',pkg$license
 535              ,'license.  On a Debian GNU/Linux system, common'
 536              ,'licenses are included in the directory'
 537              ,'/usr/share/common-licenses/.'
 538              ,''
 539              ,'The DESCRIPTION file for the original GNU R package '
 540              ,'can be found in '
 541              ,file.path('/usr/lib/R/site-library'
 542                    ,pkg$debname
 543                    ,'DESCRIPTION'
 544                    )
 545              ,sep='\n'), width=72), con=pkg$debfile('copyright.in'))
 546 }
 547
 548 generate.control <- function(pkg) {
 549     # construct control file
 550     control = data.frame()
 551     control[1,'Source'] = pkg$srcname
 552     control[1,'Section'] = 'math'
 553     control[1,'Priority'] = 'optional'
 554     control[1,'Maintainer'] = maintainer
 555     control[1,'Build-Depends'] = paste(pkg$depends$build,collapse=', ')
 556     control[1,'Standards-Version'] = '3.8.0'
 557
 558     control[2,'Package'] = pkg$debname
 559     control[2,'Architecture'] = 'all'
 560     if (pkg$archdep) {
 561         control[2,'Architecture'] = 'any'
 562     }
 563     control[2,'Depends'] = paste(pkg$depends$bin,collapse=', ')
 564
 565     # bundles provide virtual packages of their contents
 566     if (pkg$is_bundle) {
 567         control[2,'Provides'] = paste(
 568                     lapply(r.bundle.contains(pkg$name)
 569                           ,function(name) return(pkgname.as.debian(paste(name)
 570                                                                   ,repopref=pkg$repo
 571                                                                   ,binary=T)))
 572                           ,collapse=', ')
 573     }
 574
 575     # generate the description
 576     descr = 'GNU R package "'
 577     if ('Title' %in% colnames(pkg$description)) {
 578         descr = paste(descr,pkg$description[1,'Title'],sep='')
 579     } else {
 580         descr = paste(descr,pkg$name,sep='')
 581     }
 582     if (pkg$is_bundle) {
 583         long_descr <- pkg$description[1,'BundleDescription']
 584     } else {
 585         long_descr <- pkg$description[1,'Description']
 586     }
 587     # using \n\n.\n\n is not very nice, but is necessary to make sure
 588     # the longer description does not begin on the synopsis line --- R's
 589     # write.dcf does not appear to have a nicer way of doing this.
 590     descr = paste(descr,'"\n\n', long_descr, sep='')
 591     if ('URL' %in% colnames(pkg$description)) {
 592         descr = paste(descr,'\n\nURL: ',pkg$description[1,'URL'],sep='')
 593     }
 594     control[2,'Description'] = descr
 595
 596     # Debian policy says 72 char width; indent minimally
 597     write.dcf(control,file=pkg$debfile('control.in'),indent=1,width=72)
 598     write.dcf(control,indent=1,width=72)
 599 }
 600
 601 prepare.new.debian <- function(pkg,extra_deps) {
 602     # generate Debian version and name
 603     pkg$repo = repourl.as.debian(pkg$repoURL)
 604     pkg$debversion = version.new(pkg$version)
 605     if (!length(grep('^[A-Za-z0-9][A-Za-z0-9+.-]+$',pkg$name))) {
 606         stop(paste('Cannot convert package name into a Debian name',pkg$name))
 607     }
 608     pkg$srcname = tolower(pkg$name)
 609     pkg$debname = pkgname.as.debian(pkg$name,repo=pkg$repo)
 610
 611     if (!length(grep('\\.tar\\.gz',pkg$archive))) {
 612         stop('archive is not tarball')
 613     }
 614
 615     # re-pack into a Debian-named archive with a Debian-named directory.
 616     debpath = file.path(dirname(pkg$archive)
 617                    ,paste(pkg$srcname,'-'
 618                          ,pkg$version
 619                          ,sep=''))
 620     file.rename(pkg$path, debpath)
 621     pkg$path = debpath
 622     debarchive = file.path(dirname(pkg$archive)
 623                           ,paste(pkg$srcname,'_'
 624                                 ,pkg$version,'.orig.tar.gz'
 625                                 ,sep=''))
 626     wd <- getwd()
 627     setwd(dirname(pkg$path))
 628     # remove them pesky +x files
 629     system(paste('find',shQuote(basename(pkg$path))
 630                 ,'-type f -exec chmod -x {} \\;'))
 631     # tar it all back up
 632     system(paste('tar -czf',shQuote(debarchive),shQuote(basename(pkg$path))))
 633     setwd(wd)
 634     file.remove(pkg$archive)
 635     pkg$archive = debarchive
 636
 637     # make the debian/ directory
 638     debdir <- file.path(pkg$path,'debian')
 639     pkg$debfile <- function(x) { file.path(debdir,x) }
 640     unlink(debdir,recursive=T)
 641     dir.create(debdir)
 642
 643     # see if this is an architecture-dependent package.
 644     # heuristic: if /src/ exists in pkg$path, then this is an
 645     #            architecture-dependent package.
 646     # CRAN2DEB.pm is a bit fancier about this but ``Writing R extensions''
 647     # says: ``The sources and headers for the compiled code are in src, plus
 648     # optionally file Makevars or Makefile.'' It seems unlikely that
 649     # architecture independent code would end up here.
 650     if (pkg$is_bundle) {
 651         # if it's a bundle, check each of the packages
 652         pkg$archdep = F
 653         for (pkgname in r.bundle.contains(pkg$name)) {
 654             pkg$archdep = file.exists(file.path(pkg$path,pkgname,'src'))
 655             if (pkg$archdep) {
 656                 break
 657             }
 658         }
 659     } else {
 660         pkg$archdep = file.exists(file.path(pkg$path,'src'))
 661     }
 662     pkg$arch <- 'all'
 663     if (pkg$archdep) {
 664         pkg$arch <- host.arch()
 665     }
 666
 667     pkg$license <- accept.license(pkg)
 668     pkg$depends <- get.dependencies(pkg,extra_deps)
 669     generate.changelog(pkg)
 670     generate.rules(pkg)
 671     generate.copyright(pkg)
 672     generate.control(pkg)
 673
 674     # TODO: debian/watch from pkg$repoURL
 675
 676     # convert text to utf8 (who knows what the original character set is --
 677     # let's hope iconv DTRT).
 678     for (file in c('control','changelog','copyright')) {
 679         system(paste('iconv -o ',shQuote(pkg$debfile(file))
 680                     ,' -t utf8 '
 681                     ,shQuote(pkg$debfile(paste(file,'in',sep='.')))))
 682         file.remove(pkg$debfile(paste(file,'in',sep='.')))
 683     }
 684     return(pkg)
 685 }
 686
 687 build.debian <- function(pkg) {
 688     wd <- getwd()
 689     setwd(pkg$path)
 690     message(paste('N: building Debian package'
 691                  ,pkg$debname
 692                  ,paste('(',pkg$debversion,')',sep='')
 693                  ,'...'))
 694     ret = system(paste('pdebuild --configfile',pbuilder_config))
 695     setwd(wd)
 696     if (ret != 0) {
 697         stop('Failed to build package.')
 698     }
 699 }
 700
 701 changesfile <- function(srcname,version='*') {
 702     return(file.path(pbuilder_results
 703                     ,paste(srcname,'_',version,'_'
 704                           ,host.arch(),'.changes',sep='')))
 705 }
 706
 707 go <- function(name,extra_deps) {
 708     dir <- setup()
 709     pkg <- try((function() {
 710         pkg <- prepare.new.debian(prepare.pkg(dir,name),extra_deps)
 711         if (file.exists(changesfile(pkg$srcname,pkg$debversion))) {
 712             message(paste('N: already built',pkg$srcname,'version',pkg$debversion))
 713             return(pkg)
 714         }
 715
 716         # delete the current archive (XXX: assumes mini-dinstall)
 717         for (subdir in c('mini-dinstall','unstable')) {
 718             path = file.path(dinstall_archive,subdir)
 719             if (file.exists(path)) {
 720                 unlink(path,recursive=T)
 721             }
 722         }
 723
 724         # delete notes of upload
 725         file.remove(Sys.glob(file.path(pbuilder_results,'*.upload')))
 726
 727         # make mini-dinstall generate the skeleton of the archive
 728         ret = system(paste('umask 022;mini-dinstall --batch -c',dinstall_config))
 729         if (ret != 0) {
 730             stop('failed to create archive')
 731         }
 732
 733         # pull in all the R dependencies
 734         message(paste('N: dependencies:',paste(pkg$depends$r,collapse=', ')))
 735         for (dep in pkg$depends$r) {
 736             message(paste('N: uploading',dep))
 737             ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local'
 738                         ,changesfile(dep)))
 739             if (ret != 0) {
 740                 stop('upload of dependency failed! maybe you did not build it first?')
 741             }
 742         }
 743         build.debian(pkg)
 744
 745         # upload the package
 746         ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local'
 747                     ,changesfile(pkg$srcname,pkg$debversion)))
 748         if (ret != 0) {
 749             stop('upload failed!')
 750         }
 751
 752         return(pkg)
 753     })())
 754     cleanup(dir)
 755     if (inherits(pkg,'try-error')) {
 756         stop(call.=F)
 757     }
 758     return(pkg)
 759 }
 760
 761 if (exists('argv')) { # check for littler
 762     argc <- length(argv)
 763     extra_deps = list()
 764     extra_deps$deb = c()
 765     extra_deps$r = c()
 766     opts = c('-D','-R')
 767     for (i in 1:argc) {
 768         if (!(argv[i] %in% opts)) {
 769             if (argc >= i) {
 770                 argv <- argv[i:argc]
 771             } else {
 772                 argv <- list()
 773             }
 774             argc = argc - i + 1
 775             break
 776         }
 777         if (i == argc) {
 778             message('E: missing argument')
 779             q(save='no')
 780         }
 781         if (argv[i] == '-D') {
 782             extra_deps$deb = c(extra_deps$deb,strsplit(chomp(argv[i+1]),',')[[1]])
 783         }
 784         if (argv[i] == '-R') {
 785             extra_deps$r = c(extra_deps$r,strsplit(chomp(argv[i+1]),',')[[1]])
 786             extra_deps$deb = c(extra_deps$deb,lapply(extra_deps$r,pkgname.as.debian))
 787         }
 788     }
 789     if (argc == 0) {
 790         message('E: usage: cran2deb [-D extra_dep1,extra_dep2,...] package package ...')
 791         q(save='no')
 792     }
 793     build_order <- r.dependency.closure(c(extra_deps$r,argv))
 794     message(paste('N: build order',paste(build_order,collapse=', ')))
 795     for (pkg in build_order) {
 796         go(pkg,extra_deps)
 797     }
 798 }