-- |Basic types for the Apt library.moduleDebian.Repo.Changes(-- * read, showparseLog-- String -> [ChangeLogEntry],parseEntry-- String -> Maybe (ChangeLogEntry, String),parseChanges-- String -> Maybe ChangeLogEntry,showHeader-- ChangeLogEntry -> String-- * Changes File,findChangesFiles--, Section--, sectionName--, subSectionName--, load,parseChangesFilename,parseChangesFile,save,key,matchKey,base,Debian.Repo.Changes.path,name--, poolDir -- PackageIndex -> ChangesFile -> FilePath,poolDir'-- Release -> ChangesFile -> ChangedFileSpec -> FilePath,uploadLocal,ChangesFile(..),changesFileName,ChangedFileSpec(..),ChangeLogEntry(..))whereimportControl.Monad.TransimportData.List(isSuffixOf,intercalate)importData.MaybeimportqualifiedDebian.Control.StringasSimportDebian.Repo.LocalRepositoryimportDebian.Repo.TypesimportDebian.VersionimportExtra.Files(replaceFile)importExtra.CIO(CIO)importSystem.FilePath(splitFileName,(</>))importSystem.DirectoryimportqualifiedSystem.Posix.FilesasFimportText.ParserCombinators.ParsecimportText.RegeximportqualifiedDebian.Control.ByteStringasBimportDebian.URI()importSystem.Posix.Types-- |A file generated by dpkg-buildpackage describing the result of a-- package builddataChangesFile=Changes{changeDir::FilePath-- ^ The full pathname of the directory holding the .changes file.,changePackage::String-- ^ The package name parsed from the .changes file name,changeVersion::DebianVersion-- ^ The version number parsed from the .changes file name,changeRelease::ReleaseName-- ^ The Distribution field of the .changes file,changeArch::Arch-- ^ The architecture parsed from the .changes file name,changeInfo::S.Paragraph-- ^ The contents of the .changes file,changeEntry::ChangeLogEntry-- ^ The value of the Changes field of the .changes file,changeFiles::[ChangedFileSpec]-- ^ The parsed value of the Files attribute}-- |An entry in the list of files generated by the build.dataChangedFileSpec=ChangedFileSpec{changedFileMD5sum::String,changedFileSize::FileOffset,changedFileSection::SubSection,changedFilePriority::String,changedFileName::FilePath}-- |A changelog is a series of ChangeLogEntriesdataChangeLogEntry=Entry{logPackage::String,logVersion::DebianVersion,logDists::[ReleaseName],logUrgency::String,logComments::String,logWho::String,logDate::String}instanceShowChangesFilewhereshow=changesFileNamechangesFileName::ChangesFile->StringchangesFileNamechanges=changePackagechanges++"_"++show(changeVersionchanges)++"_"++archName(changeArchchanges)++".changes"instanceShowChangedFileSpecwhereshowfile=changedFileMD5sumfile++" "++show(changedFileSizefile)++" "++sectionName(changedFileSectionfile)++" "++changedFilePriorityfile++" "++changedFileNamefileinstanceShowChangeLogEntrywhereshow(Entrypackageversiondistsurgencydetailswhodate)=package++" ("++showversion++") "++intercalate" "(mapreleaseName'dists)++"; urgency="++urgency++"\n\n"++details++" -- "++who++" "++date++"\n\n"-- |Show just the top line of a changelog entry (for debugging output.)showHeader::ChangeLogEntry->StringshowHeader(Entrypackageversiondistsurgency___)=package++" ("++showversion++") "++intercalate" "(mapreleaseName'dists)++"; urgency="++urgency++"..."-- |Parse a Debian Changelog and return a lazy list of entriesparseLog::String->[EitherStringChangeLogEntry]parseLogtext=caseparseEntrytextofNothing->[]Just(Leftmessage)->[Leftmessage]Just(Right(entry,text'))->Rightentry:parseLogtext'-- |Parse a single changelog entry, returning the entry and the remaining text.parseEntry::String->Maybe(EitherString(ChangeLogEntry,String))parseEntrytext|dropWhile(\x->elemx" \t\n")text==""=NothingparseEntrytext=casematchRegexAllentryREtextofNothing->Just(Left("Parse error in changelog:\n"++text))Just("",_,remaining,[_,name,version,dists,urgency,_,details,_,_,_,_,_,who,date,_])->letentry=Entryname(parseDebianVersionversion)(mapparseReleaseName.words$dists)urgencydetailswhodateinJust(Right(entry,remaining))Just("",_,_remaining,submatches)->Just(Left("Internal error 15, submatches="++showsubmatches))Just(before,_,_,_)->Just(Left("Parse error in changelog at:\n"++showbefore++"\nin:\n"++text))whereentryRE=mkRegex$bol++blankLines++headerRE++nonSigLines++blankLines++signature++blankLinesnonSigLines="((( .*)|([ \t]*)\n)+)"-- In the debian repository, sometimes the extra space in front of the-- day-of-month is missing, sometimes an extra one is added.signature="( -- ([^\n]*) (..., ? ?.. ... .... ........ .....))[ \t]*\n"-- |Parse the changelog information that shows up in the .changes-- file, i.e. a changelog entry with no signature.parseChanges::String->MaybeChangeLogEntryparseChangestext=casematchRegexchangesREtextofNothing->NothingJust[_,name,version,dists,urgency,_,details]->Just$Entryname(parseDebianVersionversion)(mapparseReleaseName.words$dists)urgencydetails""""Justx->error$"Unexpected match: "++showxwherechangesRE=mkRegexWithOpts(bol++blankLines++optWhite++headerRE++"(.*)$")FalseFalseheaderRE=package++version++dists++urgencywherepackage="([^ \t(]*)"++optWhiteversion="\\(([^)]*)\\)"++optWhitedists="([^;]*);"++optWhiteurgency="urgency=([^\n]*)\n"++blankLinesblankLines=blankLine++"*"blankLine="("++optWhite++"\n)"optWhite="[ \t]*"bol="^"findChangesFiles::FilePath->IO[ChangesFile]findChangesFilesdir=getDirectoryContentsdir>>=return.filter(isSuffixOf".changes")>>=mapM(loaddir)>>=return.catMaybesload::FilePath->String->IO(MaybeChangesFile)loaddirfile=docaseparseChangesFilenamefileofJust(name,ver,arch)->doresult<-parseChangesFiledirfilecaseresultofRight(S.Controlchanges)->-- The .changes file should be a single paragraph,-- but there have been instances where extra newlines-- are inserted. To be forgiving we will concat all-- the paragraphs into one (rather than erroring out-- or discarding all but the first paragraph.)letchanges'=mergeParagraphschangesincase(S.fieldValue"Files"changes',maybeNothingparseChanges(S.fieldValue"Changes"changes'),S.fieldValue"Distribution"changes')of(Justtext,Justentry,Justrelease)->doreturn.Just$Changes{changeDir=dir,changePackage=name,changeVersion=ver,changeRelease=parseReleaseNamerelease,changeArch=arch,changeInfo=changes',changeEntry=entry,changeFiles=parseFileListtext}_->returnNothing-- Missing 'Files', 'Changes', or 'Distribution' field in .changesLeft_error->returnNothingNothing->returnNothing-- Couldn't parse changes filenamemergeParagraphs::[S.Paragraph]->S.ParagraphmergeParagraphsparagraphs=S.Paragraph.concat.mapfieldsOf$paragraphswherefieldsOf(S.Paragraphfields)=fieldssave::ChangesFile->IO()savechanges=replaceFilepath(show(updateFiles(changeFileschanges)(changeInfochanges)))wherepath=changeDirchanges++"/"++changesFileNamechangesupdateFilesfilesinfo=S.modifyField"Files"(const(showFileListfiles))infokey::ChangesFile->(String,DebianVersion,Arch)keychanges=(changePackagechanges,changeVersionchanges,changeArchchanges)matchKey::ChangesFile->(String,DebianVersion,Arch)->BoolmatchKeychangeskey=key==(changePackagechanges,changeVersionchanges,changeArchchanges)base::ChangesFile->Stringbasechanges=changePackagechanges++"_"++show(changeVersionchanges)++"_"++archName(changeArchchanges)name::ChangesFile->FilePathnamechanges=basechanges++".changes"path::ChangesFile->FilePathpathchanges=changeDirchanges++"/"++namechanges-- filename name version arch extparseChangesFilename::String->Maybe(String,DebianVersion,Arch)parseChangesFilenamename=casematchRegex(mkRegex"^(.*/)?([^_]*)_(.*)_([^.]*)\\.changes$")nameofJust[_,name,version,arch]->Just(name,parseDebianVersionversion,Binaryarch)_->error("Invalid .changes file name: "++name)parseChangesFile::FilePath->String->IO(EitherParseErrorS.Control)parseChangesFiledirfile=S.parseControlFromFile(dir++"/"++file)parseFileList::String->[ChangedFileSpec]parseFileListtext=-- md5sum size section priority namecase(text,matchRegexAllretext)of("",_)->[](_,Just(_,_,remaining,[md5sum,size,section,priority,filename]))->ChangedFileSpec{changedFileMD5sum=md5sum,changedFileSize=readsize,changedFileSection=parseSectionsection,changedFilePriority=priority,changedFileName=filename}:parseFileListremaining_->error("Parse error in Files section of changes file: '"++text)wherere=mkRegex("^[ \t\n]*"++g++w++g++w++g++w++g++w++g++"[ \t\n]*")g="("++t++")"t="[^ \t\n]+"w="[ \t]+"showFileList::[ChangedFileSpec]->StringshowFileListfiles=concat(map(("\n "++).show)files)-- | Return the subdirectory in the pool where a source package would be-- installed.poolDir'::Release->ChangesFile->ChangedFileSpec->FilePathpoolDir'releasechangesfile=caseS.fieldValue"Source"(changeInfochanges)ofNothing->error"No 'Source' field in .changes file"Justsource->casereleaseReporeleaseofLocalReporepo->poolDirrepo(section.changedFileSection$file)sourcex->error$"Unexpected repository passed to poolDir': "++showx-- | Move a build result into a local repository's 'incoming' directory.uploadLocal::CIOm=>LocalRepository->ChangesFile->m()uploadLocalrepochangesFile=doletpaths=map(\file->changeDirchangesFile</>changedFileNamefile)(changeFileschangesFile)mapM_(liftIO.install(outsidePathroot))(Debian.Repo.Changes.pathchangesFile:paths)whereroot=repoRootrepo-- Hard link a file into the incoming directoryinstallrootpath=doremoveIfExists(destrootpath)F.createLinkpath(destrootpath)-- F.removeLink pathdestrootpath=root++"/incoming/"++snd(splitFileNamepath)removeIfExistspath=doexists<-doesFileExistpathifexiststhenF.removeLinkpathelsereturn()