diff options
author | Pascal Terjan <pterjan@mageia.org> | 2011-01-07 08:07:11 +0000 |
---|---|---|
committer | Pascal Terjan <pterjan@mageia.org> | 2011-01-07 08:07:11 +0000 |
commit | abc9a802404902718dc808fdce36f226533f02de (patch) | |
tree | fc46dc3b0da9bf9fead8a50c9a6a3d8a5e27a75a | |
download | mga-youri-submit-abc9a802404902718dc808fdce36f226533f02de.tar mga-youri-submit-abc9a802404902718dc808fdce36f226533f02de.tar.gz mga-youri-submit-abc9a802404902718dc808fdce36f226533f02de.tar.bz2 mga-youri-submit-abc9a802404902718dc808fdce36f226533f02de.tar.xz mga-youri-submit-abc9a802404902718dc808fdce36f226533f02de.zip |
get_file_name returns a full path, which Install does not like
56 files changed, 5540 insertions, 0 deletions
diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..031adca --- /dev/null +++ b/ChangeLog @@ -0,0 +1,606 @@ +2008-02-19 07:50 pixel + + * lib/Youri/Submit/Action/Unpack.pm: fix "grep_files" handling + +2008-02-12 09:42 blino + + * lib/Youri/Submit/Check/Rpmlint.pm: do not make rpmlint errors + fatal anymore (asked by fcrozat) + +2008-02-08 17:49 blino + + * lib/Youri/Submit/Check/Rpmlint.pm: remove results occurences and + update doc + +2008-02-08 17:48 blino + + * lib/Youri/Submit/Check/Rpmlint.pm: make all rpmlint errors fatal + +2008-02-08 17:44 blino + + * lib/Youri/Submit/Check/Rpmlint.pm: removed unneeded parentheses + +2008-02-08 17:44 blino + + * lib/Youri/Submit/Check/Rpmlint.pm: make clear + repository/target/define are unused + +2008-02-08 17:43 blino + + * lib/Youri/Submit/Check/Rpmlint.pm: use scalar for fd + +2008-01-31 16:35 pixel + + * lib/Youri/Submit/Action/Link.pm: also call ->set_arch_changed + when linking a noarch file to another arch + (this still doesn't explain media/media_info/MD5SUM not being + remade, but it + can help...) + +2007-12-21 14:37 blino + + * bin/youri-submit.in: merge youri-submit into youri-submit.in + +2007-12-19 13:43 blino + + * lib/Youri/Submit/Action/Archive.pm: only log main/updates + modifications, not contrib/updates or non-free/updates which are + legal + +2007-12-19 13:37 blino + + * lib/Youri/Submit/Action/Archive.pm: add spuk's debug code for bug + 34999 + +2007-12-17 19:45 blino + + * bin/youri-submit: add an "allow_omitting_packages" global option, + to be able to run youri even if no packages are specified on the + command line (useful if packages are fetched in pre action) + +2007-12-17 19:34 blino + + * bin/youri-submit: improve error messages for pres/posts actions + (patch from raoh's copy, probably from warly) + +2007-12-17 19:33 blino + + * bin/youri-submit: fix typo about posts actions (patch from raoh's + copy, probably from warly) + +2007-12-13 15:01 pixel + + * lib/Youri/Submit/Check/Version.pm: - empty {authorized_users} + doesn't imply every one is allowed to bypass freeze check! + - {authorized_users} should be checked more strictly + +2007-12-07 18:26 spuk + + * lib/Youri/Submit/Action/Sendcache.pm: - make Sendcache send debug + packages only if explicitly told to, to save space + +2007-11-30 19:29 spuk + + * lib/Youri/Submit/Action/UpdateMdvDb.pm: Youri action to update + the Mandriva maintainers database. + +2007-10-04 20:07 blino + + * lib/Youri/Submit/Check/Host.pm: make host reject message more + explicit by print arch (useful when VMware-player for x86_64 + actually uses i386 as rpm arch...) + +2007-09-26 11:21 blino + + * lib/Youri/Submit/Action/Install.pm: improve log message + +2007-09-26 11:19 blino + + * lib/Youri/Submit/Action/Install.pm: fix installed filename (oops) + +2007-09-26 09:58 blino + + * lib/Youri/Submit/Action/Install.pm: throw exception on failure, + not to delete files that can be copied because of lack of space + (upstream commit 1398) + +2007-09-25 10:49 pixel + + * lib/Youri/Submit/Action/Unpack.pm: allow to unpack only some + files (for release-notes.txt in mandriva-release-common) + +2007-09-22 13:11 blino + + * lib/Youri/Submit/Check/Version.pm: allow authorized users to + upload everything even during full freeze + +2007-08-31 12:51 pixel + + * lib/Youri/Submit/Check/Rpmlint.pm: handle new rpmlint format + (not useful at the moment since we still use old rpmlint, but may + be useful in + the future) + +2007-08-31 10:03 blino + + * lib/Youri/Submit/Action/DkmsModuleInfo.pm: adapt to new + SOURCEPACKAGE value in prebuilt dkms kernel + +2007-08-29 13:21 blino + + * lib/Youri/Submit/Action/DkmsModuleInfo.pm: initial + Youri::Submit::Action::DkmsModuleInfo module + +2007-08-07 12:50 pixel + + * lib/Youri/Submit/Action/Link.pm: we need the same workaround as + done in Action::Install + +2007-07-16 09:27 blino + + * lib/Youri/Submit/Post/Genhdlist2.pm: remove unused variable + +2007-07-08 02:44 spuk + + * lib/Youri/Submit/Check/Recency.pm: - check for newer/current + revisions in default section when submitted to another section + (bug #30635) + +2007-07-02 09:17 pixel + + * lib/Youri/Submit/Action/CVS.pm: drop mdv specific stuff (mdv + doesn't use this action anymore) + +2007-06-28 07:40 pixel + + * lib/Youri/Submit/Action/Link.pm: do update hdlist for every arch + after linking noarch packages (#31638) + +2007-06-28 07:37 pixel + + * lib/Youri/Submit/Action/Install.pm: simplify ($arch is not used + by ->set_install_dir_changed) + +2007-06-23 13:54 pixel + + * lib/Youri/Submit/Action/Mail.pm, lib/Youri/Submit/Reject/Mail.pm: + keep raw changelogs to avoid changing the format (backport) + +2007-06-23 08:10 spuk + + * lib/Youri/Submit/Check/Recency.pm: - check for newer and same + existing revisions in a single pass + - use proper get_revisions() instead of get_install_file() hack, + as the + latter will use the current file name, and thus will fail to + check for an + existing package revision when submitting, because submitted + SRPMs have a + different name ("@rev:foobar-...") than what goes into the + repository + +2007-06-22 13:51 pixel + + * lib/Youri/Submit/Post/CleanRpmsrate.pm: ensure we don't do + anything if nothing changed + +2007-06-22 13:41 pixel + + * lib/Youri/Submit/Post/Genhdlist2.pm: more atomic generation of + MD5SUM + +2007-06-22 13:35 pixel + + * lib/Youri/Submit/Post/Genhdlist2.pm: - need to redo global + MD5SUM. This MD5SUM is mostly obsolete, but is still needed up to + 2007.1 + (and needed even on cooker for existing urpmi.cfg) + - don't use --blind. hopefully not needed + +2007-06-22 06:45 pixel + + * lib/Youri/Submit/Post/Genhdlist2.pm: call genhdlist2 with (new) + option --allow-empty-media + +2007-06-21 10:13 blino + + * lib/Youri/Submit/Post/CleanRpmsrate.pm: uniquify arch list + +2007-06-21 08:16 pixel + + * lib/Youri/Submit/Action/Install.pm, + lib/Youri/Submit/Post/Genhdlist2.pm: new action Genhdlist2 + +2007-06-14 18:23 mrl + + * lib/Youri/Submit/Action/Sendcache.pm: - As this action is unique, + avoid too much flexibility and simplify the code. + - Use . for hidding temporary files instead of .new suffix. + +2007-06-13 18:36 mrl + + * lib/Youri/Submit/Action/Sendcache.pm: - Adapted for working with + iurt cache. + +2007-06-13 01:48 spuk + + * lib/Youri/Submit/Action/Link.pm: no such 'cd' function, 'chdir' + it is... + +2007-05-08 06:22 spuk + + * lib/Youri/Submit/Reject/Mail.pm: fixing the Big SVN Breakage: + reverting last commit, restoring state as of latest working + checkout in ken + +2007-05-08 06:06 spuk + + * lib/Youri/Submit/Post/Gendistrib.pm: fixing the Big SVN Breakage: + restoring state as of working checkout in ken + +2007-05-08 06:00 spuk + + * lib/Youri/Submit/Action/Scp.pm: fixing the Big SVN Breakage: + Scp.pm was changed into Send.pm + +2007-05-05 06:16 spuk + + * lib/Youri/Submit/Check/Section.pm: Check if package submission + was for the correct section. + +2007-03-24 11:36 spuk + + * lib/Youri/Submit/Action/Archive.pm: - moved hack for verbosity to + start of code, with a remark + - removed double $path from debug string + +2007-03-15 12:36 mrl + + * lib/Youri/Submit/Check/Version.pm: - Fixed version_freeze mode: + do not allow any upload with a different version + from what is already present on the repository. + - Added an ACL control for maintainers allowed to bypass this + restriction as option + authorized_users. + +2007-03-15 12:32 mrl + + * lib/Youri/Submit/Check/Version.pm: - Improved indentation. + - Added some comments regarding possible bugs in freeze modes. + +2005-05-24 14:40 Sawyer + + * lib/Youri/Submit/Reject/Mail.pm: LOST + +2007-03-10 07:49 spuk + + * lib/Youri/Submit/Action/Archive.pm: The extra '/' was causing the + string to not be matched by the regexp below + for getting $rep_section and $rep_main_section, in the end making + the SRPMs + of all other subsections be removed when a newer package was + uploaded for any + subsection. (#28719) + +2007-02-26 10:56 blino + + * lib/Youri/Submit/Post/CleanRpmsrate.pm: initial + Post::CleanRpmsrate module + +2007-02-14 12:10 blino + + * lib/Youri/Submit/Check/Rpmlint.pm: match rpmlint errors that have + no value (such as non-xdg-migrated-menu, the only one we + currently use...) + +2007-02-09 22:11 blino + + * bin/youri-submit: get -> get_arg + +2007-02-09 22:09 blino + + * bin/youri-submit: merge changes from ken/kenobi + +2007-02-09 22:09 blino + + * bin/youri-submit: create youri-submit from youri-submit.in + +2007-02-09 19:39 blino + + * lib/Youri/Submit/Check/ACL.pm: add section in acl error message + +2007-02-09 19:34 blino + + * lib/Youri/Submit/Reject/Mail.pm: do not use packager adress as + from, it may be invalid (non-free packages) or not subscribed to + maintainers + +2007-02-09 18:51 blino + + * lib/Youri/Submit/Reject/Mail.pm: fix changelog in reject mail + +2007-02-09 18:50 blino + + * lib/Youri/Submit/Reject/Mail.pm: fix reject mail + +2007-02-08 17:28 pixel + + * lib/Youri/Submit/Action/Unpack.pm: also give directories to "cpio + -pdu" to ensure directories are created with same rights + +2007-02-08 14:09 pixel + + * lib/Youri/Submit/Action/Unpack.pm: This action plugin unpack + package files somewhere. + When unpack_inside_distribution_root is set, dest_directory is + relative to the distribution root. + When the package is a noarch, the wanted files are unpacked in + distribution root of each archs. + + eg: + unpack_installer_images: + class: Youri::Submit::Action::Unpack + options: + name: drakx-installer-images + source_subdir: /usr/lib*/drakx-installer-images + dest_directory: . + unpack_inside_distribution_root: 1 + +2007-01-30 10:02 pixel + + * lib/Youri/Submit/Check/ACL.pm, lib/Youri/Submit/Check/Host.pm, + lib/Youri/Submit/Check/Queue_recency.pm, + lib/Youri/Submit/Check/Rpmlint.pm, lib/Youri/Submit/Check/SVN.pm, + lib/Youri/Submit/Check/Source.pm, lib/Youri/Submit/Check/Type.pm, + lib/Youri/Submit/Check/Version.pm, lib/Youri/Submit/Pre/Rsync.pm, + lib/Youri/Submit/Reject/Archive.pm, + lib/Youri/Submit/Reject/Clean.pm, + lib/Youri/Submit/Reject/Install.pm, + lib/Youri/Submit/Reject/Mail.pm: fix $Id$ expansion + +2007-01-30 10:01 pixel + + * lib/Youri/Submit/Plugin.pm, lib/Youri/Submit/Post.pm, + lib/Youri/Submit/Pre.pm, lib/Youri/Submit/Reject.pm: fix pod and + $Id$ expansion + +2007-01-30 10:00 pixel + + * lib/Youri/Submit/Post.pm: fix pod + +2007-01-30 09:59 pixel + + * lib/Youri/Submit/Action/Send.pm: fix pod + +2007-01-30 09:58 pixel + + * lib/Youri/Submit/Action/Markrelease.pm, + lib/Youri/Submit/Action/Scp.pm: fix pod + +2007-01-30 09:49 pixel + + * lib/Youri/Submit/Action/Clean.pm, + lib/Youri/Submit/Action/Link.pm, + lib/Youri/Submit/Action/Markrelease.pm, + lib/Youri/Submit/Action/Rpminfo.pm, + lib/Youri/Submit/Action/Scp.pm, lib/Youri/Submit/Action/Send.pm: + fix $Id$ expansion + +2007-01-26 11:25 blino + + * lib/Youri/Submit/Check/ACL.pm: really match section in ACL + +2007-01-26 11:24 blino + + * lib/Youri/Submit/Check/ACL.pm: fix arch ACL matching (and thus + allow ACLs to match again) + +2006-12-24 10:31 mandrake + + * lib/Youri/Submit/Post.pm, lib/Youri/Submit/Pre.pm, + lib/Youri/Submit/Reject.pm: Removing previous pristine/ + directory. + +2006-12-24 03:15 mandrake + + * lib/Youri/Submit/Action.pm: %repsys markrelease + version: 1.0 + release: 0.20061223.3mdv2007.1 + revision: 101968 + + Copying 1.0-0.20061223.3mdv2007.1 to releases/ directory. + +2006-10-16 16:05 warly + + * lib/Youri/Submit/Check.pm: merging dev with upstream + +2006-11-14 22:01 mrl + + * lib/Youri/Submit/Action/Rpminfo.pm: - Renamed package name tag. + +2006-11-14 16:38 mrl + + * lib/Youri/Submit/Action/RpmInfo.pm, + lib/Youri/Submit/Action/Rpminfo.pm: - Renamed, due to some + enforcement (cfengine?). + +2006-11-14 13:23 mrl + + * lib/Youri/Submit/Action/RpmInfo.pm: - Added package summary to + .info files. + +2006-11-13 12:40 mrl + + * lib/Youri/Submit/Action/RpmInfo.pm: - First version of web + interface. + +2006-10-31 11:40 mandrake + + * lib/Youri/Submit/Action/Archive.pm: unlink file in Archive for + the moment (should be done in clean but the code to detect which + packages is obsoleted has to be moved + +2006-10-26 11:26 mandrake + + * lib/Youri/Submit/Action/CVS.pm: we perform CVS commit + asynchronously + +2006-10-26 11:21 mandrake + + * lib/Youri/Submit/Action/Install.pm: rename the rpm to remove the + prefix + +2006-10-26 11:18 mandrake + + * lib/Youri/Submit/Action/Mail.pm: fix double . + +2006-10-26 11:16 mandrake + + * lib/Youri/Submit/Post/Gendistrib.pm: add gendistrib command + directly into gendistrib module + +2006-10-26 11:14 mandrake + + * lib/Youri/Submit/Pre/Rsync.pm: return correct packages table for + groups + +2006-10-26 11:10 mandrake + + * lib/Youri/Submit/Reject/Install.pm: get_reject_path seems to be + the new name + +2006-10-26 11:07 mandrake + + * lib/Youri/Submit/Reject/Mail.pm: $last_change is sometime empty + +2006-10-24 11:07 warly + + * bin/youri-submit.in: exit with an error code if an error occured + in one group; s/Upload/Submit/; use new structure name from + upstream + +2006-10-23 11:48 warly + + * lib/Youri/Submit/Check/ACL.pm, + lib/Youri/Submit/Check/Queue_recency.pm, + lib/Youri/Submit/Check/Rpmlint.pm, lib/Youri/Submit/Check/SVN.pm, + lib/Youri/Submit/Check/Source.pm, + lib/Youri/Submit/Check/Version.pm: must return an empty value + +2006-10-18 12:46 warly + + * lib/Youri/Submit/Check/Rpmlint.pm: remove debug code + +2006-10-17 16:10 warly + + * lib/Youri/Submit/Check/ACL.pm: now checks must return the error + message + +2006-10-17 16:04 warly + + * lib/Youri/Submit/Check/ACL.pm, lib/Youri/Submit/Check/Host.pm, + lib/Youri/Submit/Check/Queue_recency.pm, + lib/Youri/Submit/Check/Rpmlint.pm, lib/Youri/Submit/Check/SVN.pm, + lib/Youri/Submit/Check/Source.pm, + lib/Youri/Submit/Check/Version.pm: now checks must return the + error message + +2006-10-17 15:16 warly + + * lib/Youri/Submit/Action/Clean.pm, + lib/Youri/Submit/Action/Link.pm, lib/Youri/Submit/Check/ACL.pm, + lib/Youri/Submit/Check/Host.pm, + lib/Youri/Submit/Check/Queue_recency.pm, + lib/Youri/Submit/Check/SVN.pm, lib/Youri/Submit/Check/Source.pm, + lib/Youri/Submit/Check/Type.pm, + lib/Youri/Submit/Check/Version.pm, lib/Youri/Submit/Post.pm, + lib/Youri/Submit/Pre.pm, lib/Youri/Submit/Reject.pm: + s/Upload/Submit/g + +2006-10-17 13:53 warly + + * ., ChangeLog, MANIFEST.SKIP, Makefile.PL, README, TODO, + bin/youri-submit-proxy.in, bin/youri-submit-restricted.in, + bin/youri-submit.in, etc, etc/bash_completion.d, + etc/bash_completion.d/youri-submit, etc/submit.conf, + lib/Youri/Submit/Plugin.pm, t, t/00distribution.t: merge with + upstream + +2006-10-16 16:27 warly + + * lib/Youri/Submit/Post/Gendistrib.pm, + lib/Youri/Submit/Pre/Rsync.pm, + lib/Youri/Submit/Reject/Archive.pm, + lib/Youri/Submit/Reject/Clean.pm, + lib/Youri/Submit/Reject/Install.pm, + lib/Youri/Submit/Reject/Mail.pm: Now the module is Submit and not + Upload + +2006-10-16 16:26 warly + + * lib/Youri/Submit/Check, lib/Youri/Submit/Check/History.pm, + lib/Youri/Submit/Check/Precedence.pm, + lib/Youri/Submit/Check/Recency.pm, + lib/Youri/Submit/Check/Rpmlint.pm, lib/Youri/Submit/Check/Tag.pm, + lib/Youri/Submit/Check/Type.pm: merging dev with upstream + +2006-10-16 16:15 warly + + * lib/Youri/Submit/Post.pm, lib/Youri/Submit/Pre.pm, + lib/Youri/Submit/Reject.pm: now plugins are complete abstract + classes + +2006-10-16 16:08 warly + + * lib/Youri/Submit/Action.pm: merging dev with upstream + +2006-10-16 16:05 warly + + * lib/Youri/Submit/Check.pm: merging dev with upstream + +2006-10-16 13:03 warly + + * lib/Youri/Submit/Action/Markrelease.pm, + lib/Youri/Submit/Action/Scp.pm, lib/Youri/Submit/Action/Send.pm: + Now the Module is Submit + +2006-10-16 12:57 warly + + * lib/Youri/Submit/Action, lib/Youri/Submit/Action/Archive.pm, + lib/Youri/Submit/Action/Bugzilla.pm, + lib/Youri/Submit/Action/CVS.pm, lib/Youri/Submit/Action/Clean.pm, + lib/Youri/Submit/Action/Install.pm, + lib/Youri/Submit/Action/Link.pm, lib/Youri/Submit/Action/Mail.pm, + lib/Youri/Submit/Action/RSS.pm, lib/Youri/Submit/Action/Sign.pm: + merging dev with upstream + +2006-10-16 11:33 warly + + * bin/youri-check.in: add new youri subsections (from upstream) + +2006-10-16 11:30 warly + + * lib/Youri/Submit: add new youri subsections (from upstream) + +2006-10-16 11:30 warly + + * lib/Youri: add new youri subsections (from upstream) + +2006-10-16 11:30 warly + + * lib: add new youri subsections (from upstream) + +2006-10-16 11:22 warly + + * bin/youri-submit.in: add new youri subsections (from upstream) + +2006-10-16 11:18 warly + + * bin: add new youri subsections (from upstream) + +2006-10-16 11:18 warly + + * .: add new youri subsections (from upstream) + +2006-04-23 Guillaume Rousse <guillomovitch@zarb.org> 0.9 + * initial release diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..f2568cb --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,11 @@ +\.tar\.gz$ +\.SKIP$ +~$ +^pm_to_blib$ +^Makefile$ +^Makefile\.old$ +^bin/youri-submit$ +^bin/youri-submit-restricted$ +^bin/youri-submit-proxy$ +.svn +blib diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..09ff7f7 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,97 @@ +# $Id: Makefile.PL 1723 2006-10-17 13:53:27Z warly $ +use ExtUtils::MakeMaker; +use Config; + +WriteMakefile( + NAME => 'youri-submit', + VERSION => 0.9, + AUTHOR => 'Youri project <youri@zarb.org>', + EXE_FILES => [ + 'bin/youri-submit', + 'bin/youri-submit-restricted', + 'bin/youri-submit-proxy' + ], + PREREQ_PM => { + 'Youri::Config' => 0, + 'Youri::Utils' => 0, + 'Pod::Simple::HTMLBatch' => 0 + }, + PREFIX => '/usr/local', + INSTALLPRIVLIB => $Config{installprivlib}, + INSTALLSITELIB => $Config{installsitelib}, + INSTALLVENDORLIB => $Config{installvendorlib}, + INSTALLMAN3DIR => $Config{installman3dir}, + INSTALLSITEMAN3DIR => $Config{installsiteman3dir}, + INSTALLVENDORMAN3DIR => $Config{installvendorman3dir}, + INSTALLSCRIPT => '$(PREFIX)/bin', + INSTALLSITESCRIPT => '$(PREFIX)/bin', + INSTALLVENDORSCRIPT => '$(PREFIX)/bin', + INSTALLMAN1DIR => '$(PREFIX)/share/man/man1', + INSTALLSITEMAN1DIR => '$(PREFIX)/share/man/man1', + INSTALLVENDORMAN1DIR => '$(PREFIX)/share/man/man1', +); + +package MY; + +sub post_constants { + my ($self) = @_; + my $sysconfdir = $self->{ARGS}->{SYSCONFDIR} || '$(PREFIX)/etc'; + return <<EOF; +SYSCONFDIR = $sysconfdir +EOF +} + +sub top_targets { + my ($self) = @_; + my $top_targets = $self->SUPER::top_targets(@_); + $top_targets =~ s/all :: pure_all manifypods/all :: pure_all manifypods htmlifypods/; + $top_targets .= <<'EOF'; +htmlifypods : $(TO_INST_PM) + if [ ! -d blib/html ]; then mkdir blib/html; fi + perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go lib blib/html + pod2html < bin/youri-submit > blib/html/youri-submit.html + pod2html < bin/youri-submit-restricted > blib/html/youri-submit-restricted.html + pod2html < bin/youri-submit-proxy > blib/html/youri-submit-proxy.html +EOF + return $top_targets; +} + +sub install { + my ($self) = @_; + my $install = $self->SUPER::install(@_); + $install =~ s/install :: all pure_install doc_install/install :: all pure_install doc_install config_install completion_install/; + $install .= <<'EOF'; +config_install : + install -d -m 755 $(DESTDIR)$(SYSCONFDIR)/youri + install -m 644 etc/submit.conf $(DESTDIR)$(SYSCONFDIR)/youri + +completion_install : + install -d -m 755 $(DESTDIR)$(SYSCONFDIR)/bash_completion.d + install -m 644 etc/bash_completion.d/youri-submit $(DESTDIR)$(SYSCONFDIR)/bash_completion.d +EOF + return $install; +} + +sub installbin { + my ($self) = @_; + my $installbin = $self->SUPER::installbin(@_); + $installbin .= <<'EOF'; +bin/youri-submit : bin/youri-submit.in Makefile + perl -p \ + -e 's|\@sysconfdir\@|$(SYSCONFDIR)|;' \ + < $< > $@ + +bin/youri-submit-restricted : bin/youri-submit-restricted.in Makefile + perl -p \ + -e 's|\@sysconfdir\@|$(SYSCONFDIR)|;' \ + -e 's|\@bindir\@|$(PREFIX)/bin|;' \ + < $< > $@ + +bin/youri-submit-proxy : bin/youri-submit-proxy.in Makefile + perl -p \ + -e 's|\@sysconfdir\@|$(SYSCONFDIR)|;' \ + -e 's|\@bindir\@|$(PREFIX)/bin|;' \ + < $< > $@ +EOF + return $installbin; +} @@ -0,0 +1,45 @@ +YOURI project +------------- + +YOURI stands for "Youri Offers an Upload & Repository Infrastucture". It aims +to build tools making management of a coherent set of packages easier. + +Description +----------- +Managing a package repository involves many tasks, such as keeping packages +tree tidy, generating packages indexes, synchronising bug report system, +running coherency checks, checking for available updates, etc... + +Instead of a gazillion project-specific scripts, we aim to provide a generic package-format independant framework, so as to build coherent and robust tools. + +Components +---------- +Available software in this release +- youri-check allows to check packages +- youri-upload allows to upload packages + +Installation +------------ +To install, just use: +perl Makefile.PL +make +make test + +All standard MakeMaker variables are usable, with the addition of SYSCONFDIR to +specify configuration files destination. + +Copyright and License +--------------------- +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +Authors +------- +Guillaume Rousse <guillomovitch@zarb.org>, +Pascal Terjan <pterjan@zarb.org> +Damien Krotkine <dams@zarb.org> +Olivier Thauvin <nanardon@zarb.org> +Ville Skyttä <ville.skytta@iki.fi> + @@ -0,0 +1,6 @@ +1.0 Goals +========= + +- svn support +- automatic bugzilla ticket closing on upload +- more customizable (template based ?) mail notification diff --git a/bin/youri-check.in b/bin/youri-check.in new file mode 100755 index 0000000..b32f4fd --- /dev/null +++ b/bin/youri-check.in @@ -0,0 +1,395 @@ +#!/usr/bin/perl +# $Id: youri-check.in 1699 2006-10-16 11:33:58Z warly $ + +=head1 NAME + +youri-check - package check agent + +=head1 VERSION + +Version 1.0 + +=head1 SYNOPSIS + +youri-check [options] <mode> + +Options: + + --config <file> use file <file> as config file + --skip-media <media> skip media <media> + --skip-plugin <plugin> skip plugin <plugin> + --parallel parallel run + --verbose verbose run + --test test run + --help print this help message + +=head1 DESCRIPTION + +B<youri-check> allows to check packages in a repository. + +In input mode, all medias defined in configuration are passed to a list of +input plugins, each of them storing their result in a persistent resultset. In +output mode, this resultset is passed to a list of output plugins, each of them +producing arbitrary effects. + +=head1 OPTIONS + +=over + +=item B<--config> <file> + +Use given file as configuration, instead of normal one. + +=item B<--skip-media> <media> + +Skip media with given identity. + +=item B<--skip-plugin> <plugin> + +Skip plugin with given identity. + +=item B<--parallel> + +Run all plugins parallelously + +=item B<--verbose> + +Produce more verbose output (can be used more than once) + +=item B<--test> + +Don't perform any modification. + +=item B<--help> + +Print a brief help message and exits. + +=back + +=head1 CONFIGURATION + +Configuration is read from the first file found among: + +=over + +=item * the one specified by B<--config> option on command-line + +=item * $HOME/.youri/check.conf + +=item * @sysconfdir@/youri/check.conf + +=back + +All additional configuration files specified by B<includes> directive are then +processed. Then command line options. Any directive overrides prior definition. + +=over + +=item B<includes> I<files> + +Uses space-separated list I<files> as a list of additional configuration files. + +=item B<resolver> I<id> + +Declare a maintainer resolver object with identity I<id>. + +=item B<preferences> I<id> + +Declare a maintainer preferences object with identity I<id>. + +=item B<resultset> I<id> + +Declare a resultset object with identity I<id>. + +=item B<medias> I<ids> + +Declares a list of media objects with identity taken in space-separated list +I<ids>. + +=item B<inputs> I<ids> + +Declares a list of input plugin objects with identity taken in space-separated +list I<ids>. + +=item B<outputs> I<ids> + +Declares a list of output plugin objects with identity taken in space-separated +list I<ids>. + +=back + +Each object declared in configuration must be fully defined later, using a +configuration section, starting with bracketed object identity, followed by at +least a class directive, then any number of additional object-specific +directives. + +Example: + + objects = foo + + [foo] + class = Foo::Bar + key1 = value1 + key2 = value2 + +=head1 SEE ALSO + +Youri::Config, for configuration file format. + +Each used plugin man page, for available options. + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +use strict; +use warnings; + +use Youri::Config; +use Youri::Utils; +use Pod::Usage; +use Net::Config qw/%NetConfig/; +use DateTime; + +my $config = Youri::Config->new( + command_spec => [ + 'config=s', + 'skip-plugin=s@', + 'skip-media=s@', + 'parallel!', + 'help|h!', + 'test|t!', + 'verbose|v!' + ], + file_spec => [ + 'includes=s', + 'resolver=s', + 'preferences=s', + 'resultset=s', + 'medias=s', + 'inputs=s', + 'outputs=s' + ], + directories => [ '@sysconfdir@', "$ENV{HOME}/.youri" ], + file_name => 'check.conf', + caller => $0, +); + +pod2usage( + -verbose => 0, + -message => "No mode specified, aborting\n" +) unless @ARGV; + +my $mode = $ARGV[0]; + +# convenient global flags +my $test = $config->get('test'); +my $verbose = $config->get('verbose'); + +# libnet configuration +my %netconfig = $config->get_section('netconfig'); +$NetConfig{$_} = $netconfig{$_} foreach keys %netconfig; + +# resultset creation +my $resultset_id = $config->get('resultset'); +die "No resultset defined" unless $resultset_id; + +report("Creating resultset $resultset_id"); +my $resultset = create_instance( + 'Youri::Check::Resultset', + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + $config->get_section($resultset_id) +); + +my $children; + +my %skip_plugins = map { $_ => 1 } @{$config->get('skip-plugin')}; + +if ($mode eq 'input') { + + # additional objects + + my $resolver; + my $resolver_id = $config->get('resolver'); + if ($resolver_id) { + report("Creating maintainer resolver $resolver_id"); + eval { + $resolver = create_instance( + 'Youri::Check::Maintainer::Resolver', + test => $test, + verbose => $verbose > 1 ? $verbose - 2 : 0, + $config->get_section($resolver_id) + ); + }; + print STDERR "Failed to create maintainer resolver $resolver_id: $@\n" if $@; + } + + my $preferences; + my $preferences_id = $config->get('preferences'); + if ($preferences_id) { + report("Creating maintainer preferences $preferences_id"); + eval { + $preferences = create_instance( + 'Youri::Check::Maintainer::Preferences', + test => $test, + verbose => $verbose > 1 ? $verbose - 2 : 0, + $config->get_section($preferences_id) + ); + }; + print STDERR "Failed to create maintainer preferences $preferences_id: $@\n" if $@; + } + + my @medias; + my %skip_medias = map { $_ => 1 } @{$config->get('skip-media')}; + foreach my $id (split(/\s+/, $config->get('medias'))) { + next if $skip_medias{$id}; + report("Creating media $id"); + eval { + push( + @medias, + create_instance( + 'Youri::Media', + id => $id, + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + $config->get_section($id) + ) + ); + }; + print STDERR "Failed to create media $id: $@\n" if $@; + } + + # prepare resultset + $resultset->reset(); + $resultset->set_resolver($resolver); + + + foreach my $id (split(/\s+/, $config->get('inputs'))) { + next if $skip_plugins{$id}; + report("Creating input $id"); + my $input; + eval { + $input = create_instance( + 'Youri::Check::Input', + id => $id, + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + resolver => $resolver, + preferences => $preferences, + $config->get_section($id) + ); + }; + if ($@) { + print STDERR "Failed to create input $id: $@\n"; + } else { + if ($config->get('parallel')) { + # fork + my $pid = fork; + die "Can't fork: $!" unless defined $pid; + if ($pid) { + # parent process + $children++; + next; + } + } + eval { + $input->prepare(@medias); + }; + if ($@) { + print STDERR "Failed to prepare input $id: $@\n"; + } else { + # clone resultset in child process + $resultset = $config->get('parallel') ? + $resultset->clone() : + $resultset; + + foreach my $media (@medias) { + next if $media->skip_input($id); + my $media_id = $media->get_id(); + report("running input $id on media $media_id"); + eval { + $input->run($media, $resultset); + }; + if ($@) { + print STDERR "Failed to run input $id on media $media_id: $@\n"; + } + } + } + if ($config->get('parallel')) { + # child process + exit; + } + } + } + +} elsif ($mode eq 'output') { + + foreach my $id (split(/\s+/, $config->get('outputs'))) { + next if $skip_plugins{$id}; + report("Creating output $id"); + my $output; + eval { + $output = create_instance( + 'Youri::Check::Output', + id => $id, + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + config => $config, + $config->get_section($id) + ); + }; + if ($@) { + print STDERR "Failed to create output $id: $@\n"; + } else { + if ($config->get('parallel')) { + # fork + my $pid = fork; + die "Can't fork: $!" unless defined $pid; + if ($pid) { + # parent process + $children++; + next; + } + } + + # clone resultset in child process + $resultset = $config->get('parallel') ? + $resultset->clone() : + $resultset; + + report("running output $id"); + eval { + $output->run($resultset); + }; + if ($@) { + print STDERR "Failed to run output $id: $@\n"; + } + + if ($config->get('parallel')) { + # child process + exit; + } + } + } +} else { + die "Invalid mode $mode"; +} + +# wait for all forked processus termination +while ($children) { + wait; + $children--; +} + +sub report { + my ($message) = @_; + print DateTime->now()->strftime('[%H:%M:%S] ') + if $verbose > 1; + print "$message\n" + if $verbose > 0; +} diff --git a/bin/youri-submit b/bin/youri-submit new file mode 100755 index 0000000..2cec209 --- /dev/null +++ b/bin/youri-submit @@ -0,0 +1,534 @@ +#!/usr/bin/perl +# $Id: youri-submit 232579 2007-12-17 19:45:47Z blino $ + +=head1 NAME + +youri-submit - package submission tool + +=head1 VERSION + +Version 2.0 + +=head1 SYNOPSIS + +youri-submit [options] <target> <files> + +youri-submit --list <category> [target] + +youri-submit --help [category] [item] + +Options: + + --config <file> use file <file> as config file + --skip-pre <pre> skip pre <pre> + --skip-check <check> skip check <check> + --skip-action <action> skip action <action> + --skip-post <post> skip post <post> + --skip-reject <reject> skip reject <reject> + --define <key>=<value> pass additional values + --clean delete package after success + --verbose verbose run + --test test run + --list <category> list items from given category + --help [category] display contextual help + +=head1 DESCRIPTION + +B<youri-submit> allows to submit packages to a repository. + +All packages given on command lines are passed to a list of check plugins, +depending on given upload target. If none of them fails, all packages are +passed to a list of action plugins, depending also on given upload target. + +=head1 OPTIONS + +=over + +=item B<--config> I<file> + +Use given file as configuration, instead of normal one. + +=item B<--skip-pre> I<id> + +Skip pre transaction plugin with given identity + +=item B<--skip-check> I<id> + +Skip check plugin with given identity. + +=item B<--skip-action> I<id> + +Skip action plugin with given identity. + +=item B<--skip-post> I<id> + +Skip post transaction plugin with given identity. + +=item B<--skip-reject> I<id> + +Skip reject action plugin with given identity. + +=item B<--define> <key>=<value> + +Define additional parameters, to be used by plugins. + +=item B<--clean> + +Delete submited packages upon successfull submission. + +=item B<--verbose> + +Produce more verbose output (can be used more than once) + +=item B<--test> + +Don't perform any modification. + +=item B<--list> I<category> + +List available items from given category and exits. Category must be either +B<targets>, B<actions> or B<checks>. A target is needed for the two last ones. + +=item B<--help> I<category> + +Display help for given category and exits. Category must be either +B<repository>, B<action> or B<check>. An item is needed for the two last ones. +If no category given, display standard help. + +=back + +=head1 CONFIGURATION + +Configuration is read from the first file found among: + +=over + +=item * the one specified by B<--config> option on command-line + +=item * $HOME/.youri/submit.conf + +=item * /usr/local/etc/youri/submit.conf + +=back + +The configuration file should be a YAML-format files, with the following +mandatory top-level directives: + +=over + +=item B<repository> + +The definition of repository plugin to be used. + +=item B<targets> + +The list of available submission targets, each one being composed from the +following keys: + +=over + +=item B<checks> + +The list of check plugins to use for this target. + +=item B<actions> + +The list of action plugins to use for this target. + +=back + +=item B<checks> + +The list of check plugin definitions, indexed by their identity. + +=item B<actions> + +The list of action plugin definitions, indexed by their identity. + +=back + +=head1 SEE ALSO + +Youri::Config, for additional details about configuration file format. + +Each used plugin man page, for available options. + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +use strict; +use warnings; + +use Youri::Config; +use Youri::Utils; +use Pod::Usage; + +my $config = Youri::Config->new( + args => { + 'skip-check' => '=s@', + 'skip-action' => '=s@', + 'define' => '=s%', + 'verbose' => '|v!', + 'clean' => '!', + 'test' => '|t!', + 'list' => '|l!', + 'config' => '=s', + 'skip-prei' => '=s@', + 'skip-post' => '=s@', + 'skip-reject' => '=s@', + }, + directories => [ "$ENV{HOME}/.youri", '/usr/local/etc/youri' ], + file => 'submit.conf', +); + +if ($config->get_arg('list')) { + my $category = $ARGV[0]; + pod2usage(-verbose => 0, -message => "No category specified, aborting\n") + unless $category; + if ($category eq 'targets') { + print join(' ', keys %{$config->get_param('targets')}); + } elsif ($category eq 'checks' || $category eq 'actions') { + my $target = $ARGV[1]; + pod2usage(-verbose => 0, -message => "No target specified, aborting\n") + unless $target; + if ($category eq 'checks') { + my $checks = $config->get_param('targets')->{$target}->{checks}; + print join(' ', @{$checks}) if $checks; + } else { + my $actions = $config->get_param('targets')->{$target}->{actions}; + print join(' ', @{$actions}) if $actions; + } + } else { + pod2usage(-verbose => 0, -message => "Invalid category $category, aborting\n") + } + print "\n"; + exit 0; +} + +if ($config->get_arg('help')) { + my $category = $ARGV[0]; + my ($item, $section); + if ($category eq 'repository') { + $section = $config->get_param('repository'); + pod2usage( + -verbose => 0, + -message => "No repository defined, aborting\n" + ) unless $section; + } elsif ($category eq 'check' || $category eq 'action') { + $item = $ARGV[1]; + pod2usage( + -verbose => 0, + -message => "No item specified, aborting\n" + ) unless $item; + if ($category eq 'check') { + $section = $config->get_param('checks')->{$item}; + pod2usage( + -verbose => 0, + -message => "No such check $item defined, aborting\n" + ) unless $section; + } else { + $section = $config->get_param('actions')->{$item}; + pod2usage( + -verbose => 0, + -message => "No such action $item defined, aborting\n" + ) unless $section; + } + } else { + pod2usage(-verbose => 0, -message => "Invalid category $category, aborting\n") + } + my $file = $section->{class} . '.pm'; + $file =~ s/::/\//g; + pod2usage( + -verbose => 99, + -sections => 'NAME|DESCRIPTION', + -input => $file, + -pathlist => \@INC + ); +} + + +pod2usage(-verbose => 0, -message => "No target specified, aborting\n") + unless @ARGV > 0; +pod2usage(-verbose => 0, -message => "No packages specified, aborting\n") + unless @ARGV > 1 || $config->get_param('allow_omitting_packages'); + +# convenient global flags +my $test = $config->get_arg('test'); +my $verbose = $config->get_arg('verbose'); + +# check target +my $target = shift @ARGV; +my $target_conf = $config->get_param('targets')->{$target}; + +# create repository +my $repository; +my $repository_conf = $config->get_param('repository'); +die "No repository declared" unless $repository_conf; +print "Creating repository\n" if $verbose; +eval { + $repository = create_instance( + 'Youri::Repository', + $repository_conf, + { + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + targets => [ keys %{$config->get_param('targets')} ], + } + ); +}; +die "Failed to create repository: $@\n" if $@; + +# perfrom pre action +my @errors; +my $pre_packages = []; +my $skip_pres = $config->get_arg('skip-pre'); +my %skip_pres = $skip_pres ? map { $_ => 1 } @{$skip_pres} : (); +foreach my $id (@{$target_conf->{pres}}) { + next if $skip_pres{$id}; + print "Creating pre $id\n" if $verbose; + my $pre; + my $pre_conf = $config->get_param('pres')->{$id}; + + if (!$pre_conf) { + print STDERR "No such pre $id, skipping\n"; + next; + } + eval { + $pre = create_instance( + 'Youri::Submit::Pre', + $pre_conf, + { + id => $id, + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + } + ); + }; + if ($@) { + print STDERR "Failed to create pre $id: $@\n"; + } else { + print "running pre $id\n" if $verbose; + my @err = $pre->run( + $pre_packages, + $repository, + $target, + $config->get_arg('define') + ); + push(@errors, @err) if $err[0]; + } +} + +if (@errors) { + print "Pre-submission errors, aborting:\n"; + foreach my $error (@errors) { + print " - $error\n"; + } + exit(1) +} + +# create packages group +my $group_error; +my @packages_group; +foreach my $group ([ map { { section => "", file => $_ } } @ARGV ], @$pre_packages) { + my @packages; + foreach my $opt (@$group) { + print "Preparing upload for $opt->{file} in $opt->{section}\n" if $verbose; + $repository->{packages}{$opt->{file}}{section} = $opt->{section}; + push( + @packages, + create_instance( + 'Youri::Package', + { + class => $repository->get_package_class(), + }, + { + file => $opt->{file}, + %$opt + }, + ) + ); + } + @packages or next; + +# check all packages pass all tests + my %errors; + my $skip_check = $config->get_arg('skip-check'); + my %skip_check = $skip_check ? map { $_ => 1 } @{$skip_check} : (); + my @error; + foreach my $id (@{$target_conf->{checks}}) { + next if $skip_check{$id}; + print "Creating check $id\n" if $verbose; + my $check; + my $check_conf = $config->get_param('checks')->{$id}; + + if (!$check_conf) { + print STDERR "No such check $id, skipping\n"; + next; + } + eval { + $check = create_instance( + 'Youri::Submit::Check', + $check_conf, + { + id => $id, + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + } + ); + }; + if ($@) { + print STDERR "Failed to create check $id: $@\n"; + } else { + foreach my $package (@packages) { + print "running check $id on package $package\n" if $verbose; + my @errors = $check->run( + $package, + $repository, + $target, + $config->get_arg('define') + ); + push(@{$errors{$package}}, @errors) if $errors[0]; + } + } + } + if (%errors) { + print "Submission errors, aborting:\n"; + foreach my $package (keys %errors) { + print "- $package:\n"; + foreach my $error (@{$errors{$package}}) { + print " - $error\n"; + } + } + # reject the packages + my $skip_rejects = $config->get_arg('skip-reject'); + my %skip_rejects = $skip_rejects ? map { $_ => 1 } @{$skip_rejects} : (); + foreach my $id (@{$target_conf->{rejects}}) { + next if $skip_rejects{$id}; + print "Creating reject $id\n" if $verbose; + my $reject; + my $reject_conf = $config->get_param('rejects')->{$id}; + + if (!$reject_conf) { + print STDERR "No such reject $id, skipping\n"; + next; + } + eval { + $reject = create_instance( + 'Youri::Submit::Reject', + $reject_conf, + { + id => $id, + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + } + ); + }; + if ($@) { + print STDERR "Failed to create reject $id: $@\n"; + } else { + foreach my $package (@packages) { + print "running reject $id on package $package\n" if $verbose; + eval { + $reject->run($package, \%errors, $repository, $target, $config->get_arg('define')); + }; + if ($@) { + print STDERR "Failed to run action $id on package $package: $@\n"; + } + } + } + } + $group_error = 1; + next + } + +# proceed further + my $skip_action = $config->get_arg('skip-action'); + my %skip_action = $skip_action ? map { $_ => 1 } @{$skip_action} : (); + foreach my $id (@{$target_conf->{actions}}) { + next if $skip_action{$id}; + print "Creating action $id\n" if $verbose; + my $action; + my $action_conf = $config->get_param('actions')->{$id}; + + if (!$action_conf) { + print STDERR "No such action $id, skipping\n"; + next; + } + eval { + $action = create_instance( + 'Youri::Submit::Action', + $action_conf, + { + id => $id, + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + } + ); + }; + if ($@) { + print STDERR "Failed to create action $id: $@\n"; + } else { + foreach my $package (@packages) { + print "running action $id on package $package\n" if $verbose; + eval { + $action->run( + $package, + $repository, + $target, + $config->get_arg('define') + ); + }; + if ($@) { + print STDERR "Failed to run action $id on package $package: $@\n"; + } + } + } + } + + if ($config->get_arg('clean')) { + foreach my $package (@packages) { + print "cleaning file $package\n" if $verbose; + unlink $package->as_file(); + } + } +} + +# perfrom post action +my $skip_post = $config->get_arg('skip-post'); +my %skip_post = $skip_post ? map { $_ => 1 } @{$skip_post} : (); +foreach my $id (@{$target_conf->{posts}}) { + next if $skip_post{$id}; + print "Creating post $id\n" if $verbose; + my $post; + my $post_conf = $config->get_param('posts')->{$id}; + + if (!$post_conf) { + print STDERR "No such post $id, skipping\n"; + next; + } + eval { + $post = create_instance( + 'Youri::Submit::Post', + $post_conf, + { + id => $id, + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + } + ); + }; + if ($@) { + print STDERR "Failed to create post $id: $@\n"; + } else { + print "running post $id\n" if $verbose; + my @err = $post->run($repository, $target, $config->get_arg('define')); + print STDERR "Error $id: @err\n" if @err + } +} + +exit(1) if $group_error; diff --git a/bin/youri-submit-proxy.in b/bin/youri-submit-proxy.in new file mode 100755 index 0000000..67fed6e --- /dev/null +++ b/bin/youri-submit-proxy.in @@ -0,0 +1,77 @@ +#!/usr/bin/perl + +=head1 NAME + +youri-submit-proxy - proxy wrapper over youri-submit-restricted + +=head1 VERSION + +Version 1.0 + +=head1 SYNOPSIS + +youri-submit-proxy [options] <target> <files> + +=head1 DESCRIPTION + +youri-submit-proxy is a proxy wrapper over youri-submit-restricted, intended to +be used in collaborative work to change uid before calling it through sudo. + +=head1 SEE ALSO + +youri-submit-restricted(1), youri-submit(1) + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +use strict; +use warnings; +use Fcntl ':mode'; +use File::Basename; + +my ($uid, $gid); +if (-l $0) { + # this is a symlink, get uid and gid from it + ($uid, $gid) = (lstat($0))[4, 5]; +} else { + ($uid, $gid) = (stat($0))[4, 5]; +} +my $user = getpwuid($uid) or die "unknown uid $uid"; +my $prog = '@bindir@/youri-submit-restricted'; + +my %dirs; +my @options; +foreach my $arg (@ARGV) { + if (-f $arg) { + # push parent dir in list + my $parent = dirname($arg); + $dirs{$parent}++; + } + push(@options, $arg); +} + +foreach my $dir (keys %dirs) { + # save original perms and gid + my ($orig_mode, $orig_gid) = (stat($dir))[2,5]; + $dirs{$dir} = { + mode => $orig_mode, + gid => $orig_gid + }; + # ensure correct perms and gid + chown -1, $gid, $dir; + chmod $orig_mode|S_IRGRP|S_IWGRP, $dir; +} + +# call wrapped program +system('sudo', '-H', '-u', $user, $prog, @options); + +foreach my $dir (keys %dirs) { + # restore original perms and gid + chown -1, $dirs{$dir}->{gid}, $dir; + chmod $dirs{$dir}->{mode}, $dir; +} diff --git a/bin/youri-submit-restricted.in b/bin/youri-submit-restricted.in new file mode 100755 index 0000000..d28ba84 --- /dev/null +++ b/bin/youri-submit-restricted.in @@ -0,0 +1,64 @@ +#!/usr/bin/perl -T + +=head1 NAME + +youri-submit-restricted - filtering wrapper over youri-submit + +=head1 VERSION + +Version 1.0 + +=head1 SYNOPSIS + +youri-submit-restricted [options] <target> <files> + +=head1 DESCRIPTION + +youri-submit-restricted is just a filtering wrapper over youri-submit, intended +to be used in collaborative work to sanitize environment and options before +calling it. + +=head1 SEE ALSO + +youri-submit(1) + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +use strict; +use warnings; + +my $prog = '@bindir@/youri-submit'; +my @prohibited_options = qw/--config --skip-check --skip-action/; +my %prohibited_options = map { $_ => 1 } @prohibited_options; +my @prohibited_envvars = qw/ + ENV BASH_ENV IFS CDPATH + PERLLIB PERL5LIB PERL5OPT PERLIO + PERLIO_DEBUG PERL5DB PERL_ENCODING + PERL_HASH_SEED PERL_SIGNALS PERL_UNICODE +/; + +my @options; +while (my $arg = shift @ARGV) { + if ($prohibited_options{$arg}) { + # drop prohibited options + print STDERR "prohibited option $arg, skipping\n"; + shift @ARGV; + } else { + # untaint everything else + $arg =~ /(.*)/; + push(@options, $1); + } +} + +# secure ENV +$ENV{PATH} = "/sbin:/usr/sbin:/bin:/usr/bin:/usr/X11R6/bin"; +delete $ENV{$_} foreach @prohibited_envvars; + +# call wrapped program +system($prog, @options); diff --git a/bin/youri-submit.in b/bin/youri-submit.in new file mode 100755 index 0000000..9892d0e --- /dev/null +++ b/bin/youri-submit.in @@ -0,0 +1,534 @@ +#!/usr/bin/perl +# $Id: youri-submit.in 232668 2007-12-21 14:37:04Z blino $ + +=head1 NAME + +youri-submit - package submission tool + +=head1 VERSION + +Version 2.0 + +=head1 SYNOPSIS + +youri-submit [options] <target> <files> + +youri-submit --list <category> [target] + +youri-submit --help [category] [item] + +Options: + + --config <file> use file <file> as config file + --skip-pre <pre> skip pre <pre> + --skip-check <check> skip check <check> + --skip-action <action> skip action <action> + --skip-post <post> skip post <post> + --skip-reject <reject> skip reject <reject> + --define <key>=<value> pass additional values + --clean delete package after success + --verbose verbose run + --test test run + --list <category> list items from given category + --help [category] display contextual help + +=head1 DESCRIPTION + +B<youri-submit> allows to submit packages to a repository. + +All packages given on command lines are passed to a list of check plugins, +depending on given upload target. If none of them fails, all packages are +passed to a list of action plugins, depending also on given upload target. + +=head1 OPTIONS + +=over + +=item B<--config> I<file> + +Use given file as configuration, instead of normal one. + +=item B<--skip-pre> I<id> + +Skip pre transaction plugin with given identity + +=item B<--skip-check> I<id> + +Skip check plugin with given identity. + +=item B<--skip-action> I<id> + +Skip action plugin with given identity. + +=item B<--skip-post> I<id> + +Skip post transaction plugin with given identity. + +=item B<--skip-reject> I<id> + +Skip reject action plugin with given identity. + +=item B<--define> <key>=<value> + +Define additional parameters, to be used by plugins. + +=item B<--clean> + +Delete submited packages upon successfull submission. + +=item B<--verbose> + +Produce more verbose output (can be used more than once) + +=item B<--test> + +Don't perform any modification. + +=item B<--list> I<category> + +List available items from given category and exits. Category must be either +B<targets>, B<actions> or B<checks>. A target is needed for the two last ones. + +=item B<--help> I<category> + +Display help for given category and exits. Category must be either +B<repository>, B<action> or B<check>. An item is needed for the two last ones. +If no category given, display standard help. + +=back + +=head1 CONFIGURATION + +Configuration is read from the first file found among: + +=over + +=item * the one specified by B<--config> option on command-line + +=item * $HOME/.youri/submit.conf + +=item * /usr/local/etc/youri/submit.conf + +=back + +The configuration file should be a YAML-format files, with the following +mandatory top-level directives: + +=over + +=item B<repository> + +The definition of repository plugin to be used. + +=item B<targets> + +The list of available submission targets, each one being composed from the +following keys: + +=over + +=item B<checks> + +The list of check plugins to use for this target. + +=item B<actions> + +The list of action plugins to use for this target. + +=back + +=item B<checks> + +The list of check plugin definitions, indexed by their identity. + +=item B<actions> + +The list of action plugin definitions, indexed by their identity. + +=back + +=head1 SEE ALSO + +Youri::Config, for additional details about configuration file format. + +Each used plugin man page, for available options. + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +use strict; +use warnings; + +use Youri::Config; +use Youri::Utils; +use Pod::Usage; + +my $config = Youri::Config->new( + args => { + 'skip-check' => '=s@', + 'skip-action' => '=s@', + 'define' => '=s%', + 'verbose' => '|v!', + 'clean' => '!', + 'test' => '|t!', + 'list' => '|l!', + 'config' => '=s', + 'skip-prei' => '=s@', + 'skip-post' => '=s@', + 'skip-reject' => '=s@', + }, + directories => [ "$ENV{HOME}/.youri", '@sysconfdir@/youri' ], + file => 'submit.conf', +); + +if ($config->get_arg('list')) { + my $category = $ARGV[0]; + pod2usage(-verbose => 0, -message => "No category specified, aborting\n") + unless $category; + if ($category eq 'targets') { + print join(' ', keys %{$config->get_param('targets')}); + } elsif ($category eq 'checks' || $category eq 'actions') { + my $target = $ARGV[1]; + pod2usage(-verbose => 0, -message => "No target specified, aborting\n") + unless $target; + if ($category eq 'checks') { + my $checks = $config->get_param('targets')->{$target}->{checks}; + print join(' ', @{$checks}) if $checks; + } else { + my $actions = $config->get_param('targets')->{$target}->{actions}; + print join(' ', @{$actions}) if $actions; + } + } else { + pod2usage(-verbose => 0, -message => "Invalid category $category, aborting\n") + } + print "\n"; + exit 0; +} + +if ($config->get_arg('help')) { + my $category = $ARGV[0]; + my ($item, $section); + if ($category eq 'repository') { + $section = $config->get_param('repository'); + pod2usage( + -verbose => 0, + -message => "No repository defined, aborting\n" + ) unless $section; + } elsif ($category eq 'check' || $category eq 'action') { + $item = $ARGV[1]; + pod2usage( + -verbose => 0, + -message => "No item specified, aborting\n" + ) unless $item; + if ($category eq 'check') { + $section = $config->get_param('checks')->{$item}; + pod2usage( + -verbose => 0, + -message => "No such check $item defined, aborting\n" + ) unless $section; + } else { + $section = $config->get_param('actions')->{$item}; + pod2usage( + -verbose => 0, + -message => "No such action $item defined, aborting\n" + ) unless $section; + } + } else { + pod2usage(-verbose => 0, -message => "Invalid category $category, aborting\n") + } + my $file = $section->{class} . '.pm'; + $file =~ s/::/\//g; + pod2usage( + -verbose => 99, + -sections => 'NAME|DESCRIPTION', + -input => $file, + -pathlist => \@INC + ); +} + + +pod2usage(-verbose => 0, -message => "No target specified, aborting\n") + unless @ARGV > 0; +pod2usage(-verbose => 0, -message => "No packages specified, aborting\n") + unless @ARGV > 1 || $config->get_param('allow_omitting_packages'); + +# convenient global flags +my $test = $config->get_arg('test'); +my $verbose = $config->get_arg('verbose'); + +# check target +my $target = shift @ARGV; +my $target_conf = $config->get_param('targets')->{$target}; + +# create repository +my $repository; +my $repository_conf = $config->get_param('repository'); +die "No repository declared" unless $repository_conf; +print "Creating repository\n" if $verbose; +eval { + $repository = create_instance( + 'Youri::Repository', + $repository_conf, + { + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + targets => [ keys %{$config->get_param('targets')} ], + } + ); +}; +die "Failed to create repository: $@\n" if $@; + +# perfrom pre action +my @errors; +my $pre_packages = []; +my $skip_pres = $config->get_arg('skip-pre'); +my %skip_pres = $skip_pres ? map { $_ => 1 } @{$skip_pres} : (); +foreach my $id (@{$target_conf->{pres}}) { + next if $skip_pres{$id}; + print "Creating pre $id\n" if $verbose; + my $pre; + my $pre_conf = $config->get_param('pres')->{$id}; + + if (!$pre_conf) { + print STDERR "No such pre $id, skipping\n"; + next; + } + eval { + $pre = create_instance( + 'Youri::Submit::Pre', + $pre_conf, + { + id => $id, + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + } + ); + }; + if ($@) { + print STDERR "Failed to create pre $id: $@\n"; + } else { + print "running pre $id\n" if $verbose; + my @err = $pre->run( + $pre_packages, + $repository, + $target, + $config->get_arg('define') + ); + push(@errors, @err) if $err[0]; + } +} + +if (@errors) { + print "Pre-submission errors, aborting:\n"; + foreach my $error (@errors) { + print " - $error\n"; + } + exit(1) +} + +# create packages group +my $group_error; +my @packages_group; +foreach my $group ([ map { { section => "", file => $_ } } @ARGV ], @$pre_packages) { + my @packages; + foreach my $opt (@$group) { + print "Preparing upload for $opt->{file} in $opt->{section}\n" if $verbose; + $repository->{packages}{$opt->{file}}{section} = $opt->{section}; + push( + @packages, + create_instance( + 'Youri::Package', + { + class => $repository->get_package_class(), + }, + { + file => $opt->{file}, + %$opt + }, + ) + ); + } + @packages or next; + +# check all packages pass all tests + my %errors; + my $skip_check = $config->get_arg('skip-check'); + my %skip_check = $skip_check ? map { $_ => 1 } @{$skip_check} : (); + my @error; + foreach my $id (@{$target_conf->{checks}}) { + next if $skip_check{$id}; + print "Creating check $id\n" if $verbose; + my $check; + my $check_conf = $config->get_param('checks')->{$id}; + + if (!$check_conf) { + print STDERR "No such check $id, skipping\n"; + next; + } + eval { + $check = create_instance( + 'Youri::Submit::Check', + $check_conf, + { + id => $id, + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + } + ); + }; + if ($@) { + print STDERR "Failed to create check $id: $@\n"; + } else { + foreach my $package (@packages) { + print "running check $id on package $package\n" if $verbose; + my @errors = $check->run( + $package, + $repository, + $target, + $config->get_arg('define') + ); + push(@{$errors{$package}}, @errors) if $errors[0]; + } + } + } + if (%errors) { + print "Submission errors, aborting:\n"; + foreach my $package (keys %errors) { + print "- $package:\n"; + foreach my $error (@{$errors{$package}}) { + print " - $error\n"; + } + } + # reject the packages + my $skip_rejects = $config->get_arg('skip-reject'); + my %skip_rejects = $skip_rejects ? map { $_ => 1 } @{$skip_rejects} : (); + foreach my $id (@{$target_conf->{rejects}}) { + next if $skip_rejects{$id}; + print "Creating reject $id\n" if $verbose; + my $reject; + my $reject_conf = $config->get_param('rejects')->{$id}; + + if (!$reject_conf) { + print STDERR "No such reject $id, skipping\n"; + next; + } + eval { + $reject = create_instance( + 'Youri::Submit::Reject', + $reject_conf, + { + id => $id, + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + } + ); + }; + if ($@) { + print STDERR "Failed to create reject $id: $@\n"; + } else { + foreach my $package (@packages) { + print "running reject $id on package $package\n" if $verbose; + eval { + $reject->run($package, \%errors, $repository, $target, $config->get_arg('define')); + }; + if ($@) { + print STDERR "Failed to run action $id on package $package: $@\n"; + } + } + } + } + $group_error = 1; + next + } + +# proceed further + my $skip_action = $config->get_arg('skip-action'); + my %skip_action = $skip_action ? map { $_ => 1 } @{$skip_action} : (); + foreach my $id (@{$target_conf->{actions}}) { + next if $skip_action{$id}; + print "Creating action $id\n" if $verbose; + my $action; + my $action_conf = $config->get_param('actions')->{$id}; + + if (!$action_conf) { + print STDERR "No such action $id, skipping\n"; + next; + } + eval { + $action = create_instance( + 'Youri::Submit::Action', + $action_conf, + { + id => $id, + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + } + ); + }; + if ($@) { + print STDERR "Failed to create action $id: $@\n"; + } else { + foreach my $package (@packages) { + print "running action $id on package $package\n" if $verbose; + eval { + $action->run( + $package, + $repository, + $target, + $config->get_arg('define') + ); + }; + if ($@) { + print STDERR "Failed to run action $id on package $package: $@\n"; + } + } + } + } + + if ($config->get_arg('clean')) { + foreach my $package (@packages) { + print "cleaning file $package\n" if $verbose; + unlink $package->as_file(); + } + } +} + +# perfrom post action +my $skip_post = $config->get_arg('skip-post'); +my %skip_post = $skip_post ? map { $_ => 1 } @{$skip_post} : (); +foreach my $id (@{$target_conf->{posts}}) { + next if $skip_post{$id}; + print "Creating post $id\n" if $verbose; + my $post; + my $post_conf = $config->get_param('posts')->{$id}; + + if (!$post_conf) { + print STDERR "No such post $id, skipping\n"; + next; + } + eval { + $post = create_instance( + 'Youri::Submit::Post', + $post_conf, + { + id => $id, + test => $test, + verbose => $verbose > 0 ? $verbose - 1 : 0, + } + ); + }; + if ($@) { + print STDERR "Failed to create post $id: $@\n"; + } else { + print "running post $id\n" if $verbose; + my @err = $post->run($repository, $target, $config->get_arg('define')); + print STDERR "Error $id: @err\n" if @err + } +} + +exit(1) if $group_error; diff --git a/etc/bash_completion.d/youri-submit b/etc/bash_completion.d/youri-submit new file mode 100644 index 0000000..be2f6e5 --- /dev/null +++ b/etc/bash_completion.d/youri-submit @@ -0,0 +1,60 @@ +# youri-submit completion +# $Id$ + +_youri-submit() +{ + + local cur prev config + + COMPREPLY=() + cur=${COMP_WORDS[COMP_CWORD]} + prev=${COMP_WORDS[COMP_CWORD-1]} + + case "$prev" in + --config) + _filedir + return 0 + ;; + --list) + COMPREPLY=( $( compgen -W 'targets checks actions' -- $cur ) ) + return 0 + ;; + --help) + COMPREPLY=( $( compgen -W 'repository check action' -- $cur ) ) + return 0 + ;; + esac + + if [[ "$cur" == -* ]]; then + COMPREPLY=( $( compgen -W '--define --clean -l --list -h --help -t \ + --test -v --verbose' -- $cur ) ) + # add dangereous option for main command + if [[ ${COMP_WORDS[0]} == youri-submit ]]; then + COMPREPLY=( $( compgen -W '${COMPREPLY[@]} --config --skip-check \ + --skip-action' -- $cur ) ) + fi + else + _count_args + case $args in + 1) + _find_config + COMPREPLY=( $( compgen -W '$( youri-submit $config --list targets )' -- $cur ) ) + ;; + *) + _filedir + ;; + esac + fi + +} +complete -F _youri-submit youri-submit youri-submit-restricted youri-submit-proxy + +_find_config() +{ + for (( i=1; i < COMP_CWORD; i++ )); do + if [[ "${COMP_WORDS[i]}" == --config ]]; then + config="--config ${COMP_WORDS[i+1]}" + break + fi + done +} diff --git a/etc/submit.conf b/etc/submit.conf new file mode 100644 index 0000000..ef23078 --- /dev/null +++ b/etc/submit.conf @@ -0,0 +1,134 @@ +# youri-submit sample configuration file +# $Id: submit.conf 1723 2006-10-17 13:53:27Z warly $ + +# helper variables +home: /home/user + +# repository definition +repository: + class: Youri::Repository::PLF + options: + install_root: ${home}/ftp/mandriva + version_root: ${home}/cvs + archive_root: ${home}/backup/mandriva + noarch: i586 + +# targets definitions +targets: + cooker: + checks: + - tag + - recency + - history + actions: + - sign + - install + - link + - archive + - clean + - bugzilla + - cvs + - mail + - rss + + 2006.0: + checks: + - type + - tag + - recency + - history + - precedence + actions: + - sign + - install + - link + - archive + - clean + +# checks definitions +checks: + tag: + class: Youri::Submit::Check::Tag + options: + tags: + release: 'plf$' + packager: '<\w+@zarb\.org>$' + distribution: '^Mandriva Linux$' + vendor: '^Penguin Liberation Front$' + + recency: + class: Youri::Submit::Check::Recency + + history: + class: Youri::Submit::Check::History + + precedence: + class: Youri::Submit::Check::Precedence + options: + target: cooker + + type: + class: Youri::Submit::Check::Type + type: binary + +# actions definitions +actions: + sign: + class: Youri::Submit::Action::Sign + options: + name: plf@zarb.org + path: ${home}/.gnupg + passphrase: s3kr3t + + install: + class: Youri::Submit::Action::Install + + link: + class: Youri::Submit::Action::Link + + archive: + class: Youri::Submit::Action::Archive + + clean: + class: Youri::Submit::Action::Clean + + mail: + class: Youri::Submit::Action::Mail + options: + mta: /usr/sbin/sendmail + to: plf-announce@zarb.org + reply_to: plf-discuss@zarb.org + from: plf@zarb.org + prefix: RPM + cc: + hot-base: david@dindinx.org bellamy@neverland.net + dcgui: mathen@ketelhot.de + dclib: mathen@ketelhot.de + Video-DVDRip: dvdrip-users@exit1.org + hackVideo-DVDRip: dvdrip-users@exit1.org + goosnes: tak@bard.sytes.net + avidemux: fixounet@free.fr + vobcopy: robos@muon.de + drip: drip-devel@lists.sourceforge.net + libdscaler: vektor@dumbterm.net + xawdecode: pingus77@ifrance.com + + rss: + class: Youri::Submit::Action::RSS + options: + file: ${home}/www/changelog.rss + title: PLF packages updates + link: http://plf.zarb.org/ + description: ChangeLog for PLF packages + + cvs: + class: Youri::Submit::Action::CVS + + bugzilla: + class: Youri::Submit::Action::Bugzilla + options: + host: localhost + base: plf_bugs + user: plf + pass: s3kr3t + contact: plf@zarb.org diff --git a/lib/Youri/Submit/Action.pm b/lib/Youri/Submit/Action.pm new file mode 100644 index 0000000..983fdc8 --- /dev/null +++ b/lib/Youri/Submit/Action.pm @@ -0,0 +1,27 @@ +# $Id: Base.pm 631 2006-01-26 22:22:23Z guillomovitch $ +package Youri::Submit::Action; + +=head1 NAME + +Youri::Submit::Action - Abstract action plugin + +=head1 DESCRIPTION + +This abstract class defines action plugin interface. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Plugin/; + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/Archive.pm b/lib/Youri/Submit/Action/Archive.pm new file mode 100644 index 0000000..98ff37c --- /dev/null +++ b/lib/Youri/Submit/Action/Archive.pm @@ -0,0 +1,90 @@ +# $Id: Archive.pm 265457 2010-01-28 13:09:30Z pterjan $ +package Youri::Submit::Action::Archive; + +=head1 NAME + +Youri::Submit::Action::Archive - Old revisions archiving + +=head1 DESCRIPTION + +This action plugin ensures archiving of old package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + @_ + ); + + $self->{_perms} = $options{perms}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + # FIXME: workaround for $self->{_verbose} not being initialized properly + $self->{_verbose} = 1; + # all this should be in Mandriva_upload.pm + my $section = $repository->_get_section($package, $target, $define); + my $main_section = $repository->_get_main_section($package, $target, $define); + print "section $section main_section $main_section\n" if $self->{_verbose}; + my $arch = $package->get_arch(); + $arch = $self->{_noarch} if $arch eq 'noarch'; + my $path = $arch eq 'src' ? "$target/SRPMS" : "$target/$arch/media"; + $path = "$repository->{_install_root}/$path"; + $path =~ s,/+,/,g; + foreach my $replaced_package ( + $repository->get_replaced_packages($package, $target, $define) + ) { + my $file = $replaced_package->get_file(); + + # trap for debugging bug 34999 + if ($file =~ /\/[\d.]+\/(main\/updates|.*\/release)/) { + my $bugmsg = "BUG#34999 WARNING: trying to remove from a release: $file\n"; + open(BUG34999LOG, '>>', "/home/mandrake/bug34999.log"); + print $bugmsg; + print BUG34999LOG localtime().": ".$bugmsg; + close BUG34999LOG; + + next; + } + + my ($rep_section, $rep_main_section) = $file =~ m,$path/(([^/]+)/.*)/[^/]+.rpm,; + # We do accept duplicate version for other submedia of the same main media section + print "(path '$path') file '$file' section '$rep_section' main_section '$rep_main_section'\n" if $self->{_verbose}; + next if $rep_main_section eq $main_section && $rep_section ne $section; + my $dest = $repository->get_archive_dir($package, $target, $define); + + print "archiving file $file to $dest\n" if $self->{_verbose}; + + unless ($self->{_test}) { + # create destination dir if needed + system("install -d -m " . ($self->{_perms} + 111) . " $dest") + unless -d $dest; + + # install file to new location + system("install -m $self->{_perms} $file $dest"); + + print "deleting file $file\n" if $self->{_verbose}; + unlink $file unless $self->{_test}; + } + } +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/Bugzilla.pm b/lib/Youri/Submit/Action/Bugzilla.pm new file mode 100644 index 0000000..04eaa4c --- /dev/null +++ b/lib/Youri/Submit/Action/Bugzilla.pm @@ -0,0 +1,81 @@ +# $Id: Bugzilla.pm 1700 2006-10-16 12:57:42Z warly $ +package Youri::Submit::Action::Bugzilla; + +=head1 NAME + +Youri::Submit::Action::Bugzilla - Bugzilla synchronisation + +=head1 DESCRIPTION + +This action plugin ensures synchronisation with Bugzilla. + +=cut + +use warnings; +use strict; +use Carp; +use Youri::Bugzilla; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + host => '', + base => '', + user => '', + pass => '', + contact => '', + @_ + ); + + $self->{_bugzilla} = Youri::Bugzilla->new( + $options{host}, + $options{base}, + $options{user}, + $options{pass} + ); + $self->{_contact} = $options{contact}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + return unless $package->is_source(); + + my $name = $package->get_name(); + my $version = $package->get_version(); + my $summary = $package->get_summary(); + my $packager = $package->get_packager(); + $packager =~ s/.*<(.*)>/$1/; + + if ($self->{_bugzilla}->has_package($name)) { + my %versions = + map { $_ => 1 } + $self->{_bugzilla}->get_versions($name); + unless ($versions{$version}) { + print "adding version $version to bugzilla\n" if $self->{_verbose}; + $self->{_bugzilla}->add_version($name, $version) + unless $self->{_test}; + } + } else { + print "adding package $name to bugzilla\n" if $self->{_verbose}; + $self->{_bugzilla}->add_package( + $name, + $summary, + $version, + $packager, + $self->{_contact} + ) unless $self->{_test}; + } +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/CVS.pm b/lib/Youri/Submit/Action/CVS.pm new file mode 100644 index 0000000..e9f1f4f --- /dev/null +++ b/lib/Youri/Submit/Action/CVS.pm @@ -0,0 +1,135 @@ +# $Id: CVS.pm 224115 2007-07-02 09:17:15Z pixel $ +package Youri::Submit::Action::CVS; + +=head1 NAME + +Youri::Submit::Action::CVS - CVS versionning + +=head1 DESCRIPTION + +This action plugin ensures CVS versionning of package sources. + +=cut + +use warnings; +use strict; +use Carp; +use Cwd; +use File::Temp qw/tempdir/; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + exclude => '\.(tar(\.(gz|bz2))?|zip)$', + perms => 644, + @_ + ); + + $self->{_exclude} = $options{exclude}; + $self->{_perms} = $options{perms}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + return unless $package->is_source(); + + my $name = $package->get_name(); + my $version = $package->get_version(); + my $release = $package->get_release(); + + my $root = $repository->get_version_root(); + my $path = $repository->get_version_path($package, $target, $define); + + # remember original directory + my $original_dir = cwd(); + + # get a safe temporary directory + my $dir = tempdir( CLEANUP => 1 ); + chdir $dir; + + # first checkout base directory only + system("cvs -Q -d $root co -l $path"); + + # try to checkout package directory + my $dest = $path . '/' . $name; + system("cvs -Q -d $root co $dest"); + + # create directory if previous import failed + unless (-d $dest) { + print "adding directory $dest\n" if $self->{_verbose}; + system("install -d -m " . ($self->{_perms} + 111) . " $dest"); + system("cvs -Q -d $root add $dest"); + } + + chdir $dest; + + # remove all files + unlink grep { -f } glob '*'; + + # extract all rpm files locally + $package->extract(); + + # remove excluded files + if ($self->{_exclude}) { + unlink grep { -f && /$self->{_exclude}/ } glob '*'; + } + + # uncompress all compressed files + system("bunzip2 *.bz2 2>/dev/null"); + system("gunzip *.gz 2>/dev/null"); + + my (@to_remove, @to_add, @to_add_binary); + foreach my $line (`cvs -nq update`) { + if ($line =~ /^\? (\S+)/) { + if (-B $1) { + push(@to_add_binary, $1); + } else { + push(@to_add, $1); + } + } + if ($line =~ /^U (\S+)/) { + push(@to_remove, $1); + } + } + if (@to_remove) { + my $to_remove = join(' ', @to_remove); + print "removing file(s) $to_remove\n" if $self->{_verbose}; + system("cvs -Q remove $to_remove"); + } + if (@to_add) { + my $to_add = join(' ', @to_add); + print "adding text file(s) $to_add\n" if $self->{_verbose}; + system("cvs -Q add $to_add"); + } + if (@to_add_binary) { + my $to_add_binary = join(' ', @to_add_binary); + print "adding binary file(s) $to_add_binary\n" if $self->{_verbose}; + system("cvs -Q add -kb $to_add_binary"); + } + + print "committing current directory\n" if $self->{_verbose}; + system("cvs -Q commit -m $version-$release") unless $self->{_test}; + + # tag new release + my $tag = "r$version-$release"; + $tag =~ s/\./_/g; + print "tagging current directory as $tag\n" if $self->{_verbose}; + system("cvs -Q tag $tag") unless $self->{_test}; + + # get back to original directory + chdir $original_dir; + +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/Clean.pm b/lib/Youri/Submit/Action/Clean.pm new file mode 100644 index 0000000..fa19254 --- /dev/null +++ b/lib/Youri/Submit/Action/Clean.pm @@ -0,0 +1,40 @@ +# $Id: Clean.pm 4742 2007-01-30 09:49:58Z pixel $ +package Youri::Submit::Action::Clean; + +=head1 NAME + +Youri::Submit::Action::Clean - Old revisions cleanup + +=head1 DESCRIPTION + +This action plugin ensures cleanup of old package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Action/; + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + foreach my $replaced_package ( + $repository->get_replaced_packages($package, $target, $define) + ) { + my $file = $replaced_package->as_file(); + print "deleting file $file\n" if $self->{_verbose}; + unlink $file unless $self->{_test}; + } +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/DkmsModuleInfo.pm b/lib/Youri/Submit/Action/DkmsModuleInfo.pm new file mode 100644 index 0000000..d1dd4a8 --- /dev/null +++ b/lib/Youri/Submit/Action/DkmsModuleInfo.pm @@ -0,0 +1,111 @@ +# $Id$ +package Youri::Submit::Action::DkmsModuleInfo; + +=head1 NAME + +Youri::Submit::Action::DkmsModuleInfo - extract and commit info from dkms package. + +=head1 DESCRIPTION + +This action plugin extract modalias and description from dkms packages and commit them +on a SVN module. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Action/; +use File::Temp qw/tempdir/; +use File::Basename; +use SVN::Client; + +#- inlineed from MDK::Common::Various +sub chomp_ { my @l = @_; chomp @l; wantarray() ? @l : $l[0] } + +sub _init { + my ($self, %options) = @_; + + croak "undefined svn module" unless $options{svn_module}; + + foreach my $var ('svn_module') { + $self->{"_$var"} = $options{$var}; + } + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my ($dkms_name) = $package->get_canonical_name =~ /^dkms-(.*)$/ or return; + my $package_name = $package->get_name; + my ($kver) = $package_name =~ /^$dkms_name-kernel-(.*)$/ or return; + + my @files = map { $_->[0] } $package->get_files; + my @module_files = grep { m!^(/lib/modules/|/var/lib/dkms-binary/).*\.ko(\.gz)?$! } @files + or return; + + print "Submit::Action::DkmsModuleInfo: proceeding with $package_name\n" if $self->{_verbose}; + + my $tempdir = tempdir(CLEANUP => 1); + my $file = $package->as_file; + my $cmd = "rpm2cpio $file | (cd $tempdir ; cpio --quiet -id)"; + print "Submit::Action::DkmsModuleInfo: doing $cmd\n" if $self->{_verbose}; + if (system($cmd) != 0) { + print "Submit::Action::DkmsModuleInfo: failed!\n" if $self->{_verbose}; + return; + } + + my @fields = qw(description alias); + + my (%modules); + foreach my $file (@module_files) { + print "Submit::Action::DkmsModuleInfo: extracting $file\n" if $self->{_verbose}; + my $module = $file; + $module =~ s!.*/!!; + $module =~ s!\.ko(\.gz)$!!; + $modules{$module}{$_} = [ chomp_(`/sbin/modinfo -F $_ $tempdir$file`) ] + foreach @fields; + } + + eval { + my $svn = SVN::Client->new(); + my $dir = $tempdir . '/' . basename($self->{_svn_module}); + my $revision = $svn->checkout($self->{_svn_module}, $dir, 'HEAD', 0); + my $vdir = $dir . '/' . $kver; + $svn->update($vdir, 'HEAD', 0); + -d $vdir or $svn->mkdir($vdir); + foreach my $module (keys %modules) { + print "Submit::Action::DkmsModuleInfo: adding module $module\n" if $self->{_verbose}; + foreach my $field (@fields) { + my $file = "$vdir/$module.$field"; + $svn->update($file, 'HEAD', 0); + my $exists = -f $file; + open(my $fh, ">", $file); + print $fh map { "$_\n" } @{$modules{$module}{$field}}; + $svn->add($file, 1) if !$exists; + } + } + + $svn->log_msg(sub { $_[0] = \"add dkms info for $dkms_name with kernel $kver" }); + $svn->commit($vdir, 0); + }; + if (my $error = $@) { + print "Submit::Action::DkmsModuleInfo: commit to svn failed ($error)!\n" if $self->{_verbose}; + return; + } + + 1; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/Install.pm b/lib/Youri/Submit/Action/Install.pm new file mode 100644 index 0000000..80e8de2 --- /dev/null +++ b/lib/Youri/Submit/Action/Install.pm @@ -0,0 +1,75 @@ +# $Id: Install.pm 229772 2007-09-26 11:21:07Z blino $ +package Youri::Submit::Action::Install; + +=head1 NAME + +Youri::Submit::Action::Install - Package installation + +=head1 DESCRIPTION + +This action plugin ensures installation of new package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use File::Basename; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + @_ + ); + + $self->{_perms} = $options{perms}; + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $package->as_file(); + my $rpm = basename($package->get_file_name()); + my $dest = $repository->get_install_dir($package, $target, $define); + + # FIXME remove prefix this should be done by a function + $rpm =~ s/^\d{14}\.\w*\.\w+\.\d+_//; + $rpm =~ s/^\@\d+://; + print "installing file $file to $dest/$rpm\n" if $self->{_verbose}; + + unless ($self->{_test}) { + # create destination dir if needed + if (! -d $dest) { + my $status = + system("install -d -m " . ($self->{_perms} + 111) . " $dest"); + croak "Unable to create directory $dest: $?" if $status; + } + + # install file to new location + my $status = + system("install -m $self->{_perms} $file $dest/$rpm"); + croak "Unable to install file $file to $dest/$rpm: $?" if $status; + + my $arch = $package->get_arch(); + $repository->set_arch_changed($target, $arch); + $repository->set_install_dir_changed($dest); + } + $package->{_file} = "$dest/$rpm"; + print "deleting file $file\n" if $self->{_verbose}; + unlink $file unless $self->{_test}; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/Link.pm b/lib/Youri/Submit/Action/Link.pm new file mode 100644 index 0000000..336eafb --- /dev/null +++ b/lib/Youri/Submit/Action/Link.pm @@ -0,0 +1,80 @@ +# $Id: Link.pm 233641 2008-01-31 16:35:55Z pixel $ +package Youri::Submit::Action::Link; + +=head1 NAME + +Youri::Submit::Action::Link - Noarch packages linking + +=head1 DESCRIPTION + +This action plugin ensures linking of noarch packages between arch-specific +directories. + +=cut + +use warnings; +use strict; +use Carp; +use Cwd; +use File::Spec; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + symbolic => 0, # use symbolic linking + @_ + ); + + $self->{_symbolic} = $options{symbolic}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + # only needed for noarch packages + return unless $package->get_arch() eq 'noarch'; + + my $default_dir = $repository->get_install_dir($package, $target, $define); + my $file = $package->get_file_name(); + + # FIXME remove prefix this should be done by a function + $file =~ s/^\d{14}\.\w*\.\w+\.\d+_//; + $file =~ s/^\@\d+://; + + foreach my $arch ($repository->get_extra_arches()) { + # compute installation target, forcing arch + my $other_dir = $repository->get_install_dir( + $package, + $target, + $define, + { arch => $arch } + ); + + if (! $self->{_test}) { + my $current_dir = cwd(); + chdir $other_dir; + my $default_file = File::Spec->abs2rel($default_dir) . '/' . $file; + if ($self->{_symbolic}) { + symlink $default_file, $file; + } else { + link $default_file, $file; + } + chdir $current_dir; + print "set_install_dir_changed($other_dir) for updated $file\n"; + $repository->set_install_dir_changed($other_dir); + $repository->set_arch_changed($target, $arch); + } + } +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/Mail.pm b/lib/Youri/Submit/Action/Mail.pm new file mode 100644 index 0000000..c9bbcbe --- /dev/null +++ b/lib/Youri/Submit/Action/Mail.pm @@ -0,0 +1,131 @@ +# $Id: Mail.pm 223952 2007-06-23 13:54:13Z pixel $ +package Youri::Submit::Action::Mail; + +=head1 NAME + +Youri::Submit::Action::Mail - Mail notification + +=head1 DESCRIPTION + +This action plugin ensures mail notification of new package revisions. + +=cut + +use warnings; +use strict; +use MIME::Entity; +use Encode qw/from_to/; +use Carp; +use Youri::Package; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + mta => '/usr/sbin/sendmail', + to => '', + from => '', + cc => '', + prefix => '', + encoding => 'quoted-printable', + charset => 'iso-8859-1', + @_ + ); + + croak "undefined mail MTA" unless $options{mta}; + croak "invalid mail MTA $options{mta}" unless -x $options{mta}; + croak "undefined to" unless $options{to}; + if ($options{cc}) { + croak "cc should be an hashref" unless ref $options{cc} eq 'HASH'; + } + croak "invalid charset $options{charset}" + unless Encode::resolve_alias($options{charset}); + + $self->{_mta} = $options{mta}; + $self->{_to} = $options{to}; + $self->{_from} = $options{from}; + $self->{_cc} = $options{cc}; + $self->{_prefix} = $options{prefix}; + $self->{_encoding} = $options{encoding}; + $self->{_charset} = $options{charset}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + return unless $package->is_source(); + + my $from = $package->get_packager(); + + # force from adress if defined + $from =~ s/<.*>/<$self->{_from}>/ if $self->{_from}; + + my $subject = $self->get_subject($package, $repository, $target, $define); + my $content = $self->get_content($package, $repository, $target, $define); + + # ensure proper codeset conversion + # for informations coming from package + my $charset = $repository->get_package_charset(); + from_to($content, $charset, $self->{_charset}); + from_to($subject, $charset, $self->{_charset}); + + my $mail = MIME::Entity->build( + Type => 'text/plain', + Charset => $self->{_charset}, + Encoding => $self->{_encoding}, + From => $from, + To => $self->{_to}, + Subject => $subject, + Data => $content, + ); + + if ($self->{_cc}) { + my $cc = $self->{_cc}->{$package->get_name()}; + $mail->head()->add('cc', $cc) if $cc; + } + + if ($self->{_test}) { + $mail->print(\*STDOUT); + } else { + open(MAIL, "| $self->{_mta} -t -oi -oem") or die "Can't open MTA program: $!"; + $mail->print(\*MAIL); + close MAIL; + } + +} + +sub get_subject { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $section = $repository->_get_section($package, $target, $define); + return + ($self->{_prefix} ? '[' . $self->{_prefix} . '] ' : '' ) . + "$target " . ($section ? "$section " : '' ) . + $package->as_formated_string('%{name}-%{version}-%{release}'); +} + +sub get_content { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $information = $package->get_information(); + my $last_change = $package->get_last_change(); + + return + $information . "\n" . + $last_change->[Youri::Package::CHANGE_AUTHOR] . ":\n" . + $last_change->[Youri::Package::CHANGE_TEXT]; +} + + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/Markrelease.pm b/lib/Youri/Submit/Action/Markrelease.pm new file mode 100644 index 0000000..a409c7c --- /dev/null +++ b/lib/Youri/Submit/Action/Markrelease.pm @@ -0,0 +1,56 @@ +# $Id: Markrelease.pm 4743 2007-01-30 09:58:30Z pixel $ +package Youri::Submit::Action::Markrelease; + +=head1 NAME + +Youri::Submit::Action::Markrelease - calls markrelease + +=head1 DESCRIPTION + +This action plugin calls markrelease + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + @_ + ); + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + $package->is_source or return 1; + my $file = $package->get_file(); + my $srpm_name = $package->get_canonical_name; + + if ($repository->package_in_svn($srpm_name)) { + my $svn = $repository->get_svn_url(); + my ($rev) = $file =~ /.*\/.*?\@(\d+):/; + print "Run repsys markrelease -f $file -r $rev $svn/$srpm_name\n"; + # FIXME repsys ask for a username and password + # FIXME we should use the key in /var/home/mandrake so that /home/mandrake does not + # need to be mounted + system('repsys', 'markrelease', '-f', $file, '-r', $rev, "$svn/$srpm_name"); + } + 1 +} +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/RSS.pm b/lib/Youri/Submit/Action/RSS.pm new file mode 100644 index 0000000..51da825 --- /dev/null +++ b/lib/Youri/Submit/Action/RSS.pm @@ -0,0 +1,102 @@ +# $Id: RSS.pm 1700 2006-10-16 12:57:42Z warly $ +package Youri::Submit::Action::RSS; + +=head1 NAME + +Youri::Submit::Action::RSS - RSS notification + +=head1 DESCRIPTION + +This action plugin ensures RSS notification of new package revisions. + +=cut + +use warnings; +use strict; +use XML::RSS; +use Encode qw/from_to/; +use Carp; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + file => '', + title => '', + link => '', + description => '', + charset => 'iso-8859-1', + max_items => 10, + @_ + ); + + croak "undefined rss file" unless $options{file}; + croak "invalid charset $options{charset}" + unless Encode::resolve_alias($options{charset}); + + $self->{_file} = $options{file}; + $self->{_title} = $options{title}; + $self->{_link} = $options{link}; + $self->{_description} = $options{description}; + $self->{_charset} = $options{charset}; + $self->{_max_items} = $options{max_items}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + return unless $package->is_source(); + + my $subject = $package->as_formated_string('%{name}-%{version}-%{release}'); + my $content = $package->get_information(); + + $content =~ s/$/<br\/>/mg; + + # ensure proper codeset conversion + # for informations coming from package + my $charset = $repository->get_package_charset(); + from_to($content, $charset, $self->{_charset}); + from_to($subject, $charset, $self->{_charset}); + + my $rss = XML::RSS->new( + encoding => $self->{_charset}, + encode_output => 1 + ); + + my $file = $self->{_file}; + if (-e $file) { + $rss->parsefile($file); + splice(@{$rss->{items}}, $self->{_max_items}) + if @{$rss->{items}} >= $self->{_max_items}; + } else { + $rss->channel( + title => $self->{_title}, + link => $self->{_link}, + description => $self->{_description}, + language => 'en' + ); + } + + $rss->add_item( + title => $subject, + description => $content, + mode => 'insert' + ); + + if ($self->{_test}) { + print $rss->as_string(); + } else { + $rss->save($file); + } +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/Rpminfo.pm b/lib/Youri/Submit/Action/Rpminfo.pm new file mode 100644 index 0000000..c96efb1 --- /dev/null +++ b/lib/Youri/Submit/Action/Rpminfo.pm @@ -0,0 +1,69 @@ +# $Id: Rpminfo.pm 4742 2007-01-30 09:49:58Z pixel $ +package Youri::Submit::Action::Rpminfo; + +=head1 NAME + +Youri::Submit::Action::RpmInfo - Creates .info files + +=head1 DESCRIPTION + +This action plugin ensures the creation of .info files + +=cut + +use warnings; +use strict; +use Carp; +use File::Basename; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + uphost => '', + user => '', + ssh_key => '', + verbose => '', + @_ + ); + croak "undefined upload host" unless $options{uphost}; + croak "undefined ssh key" unless $options{ssh_key}; + + foreach my $var ('perms', 'user', 'uphost', 'ssh_key', 'verbose') { + $self->{"_$var"} = $options{$var}; + } + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $package->get_file(); + my $dest = $repository->get_upload_dir($package, $target, $define); + + print "Caching rpm information $file on $dest\n" if $self->{_verbose}; + my $base = basename ($file); + $dest =~ s/\/[0-9]{14}\./\/*./; + + my $cmd = "ssh -i $self->{_ssh_key} $self->{_user}\@$self->{_uphost} \"srpm=`echo /$dest$base`; rpm -q --qf '\%{name}\n\%{epoch}\n\%{version}-\%{release}\n\%{summary}\n' -p \\\$srpm > \\\$srpm.info\""; + print "Submit::Action::RpmInfo: doing $cmd\n" if $self->{_verbose}; + if (!$self->{_test}) { + if (!system($cmd)) { + print "Submit::Action::RpmInfo: rpminfo succeeded!\n"; + return 1 + } + print "Submit::Action::RpmInfo: rpminfo failed!\n"; + } +} +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/Send.pm b/lib/Youri/Submit/Action/Send.pm new file mode 100644 index 0000000..9ba630b --- /dev/null +++ b/lib/Youri/Submit/Action/Send.pm @@ -0,0 +1,77 @@ +# $Id: Send.pm 4744 2007-01-30 09:59:07Z pixel $ +package Youri::Submit::Action::Send; + +=head1 NAME + +Youri::Submit::Action::Send - upload package + +=head1 DESCRIPTION + +This action plugin uploads the package on uphost + +=cut + +use warnings; +use strict; +use Carp; +use File::Basename; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + uphost => '', + user => '', + ssh_key => '', + verbose => '', + keep_svn_release => '', + @_ + ); + croak "undefined upload host" unless $options{uphost}; + croak "undefined ssh key" unless $options{ssh_key}; + + foreach my $var ('perms', 'user', 'uphost', 'ssh_key', 'verbose', 'keep_svn_release') { + $self->{"_$var"} = $options{$var}; + } + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $package->get_file(); + my $dest = $repository->get_upload_dir($package, $target, $define); + + print "Sending file $file to $dest\n" if $self->{_verbose}; + my $base; + if ($self->{_keep_svn_release}) { + $base = basename($file) + } else { + ($base) = $file =~ /.*\/(?:@\d+:)?([^\/]*)/ + } + + my $cmd = "scp -i $self->{_ssh_key} $file $self->{_user}\@$self->{_uphost}:/$dest$base.new"; + my $cmd2 = "ssh -i $self->{_ssh_key} $self->{_user}\@$self->{_uphost} \"mv /$dest$base.new /$dest$base\""; + print "Submit::Action::Send: doing $cmd\n$cmd2\n" if 1 || $self->{_verbose}; + if (!$self->{_test}) { + if (!system($cmd)) { + if (!system($cmd2)) { + print "Submit::Action::Send: upload succeeded!\n"; + return 1 + } + } + print "Submit::Action::Send: upload failed!\n"; + } +} +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/Sendcache.pm b/lib/Youri/Submit/Action/Sendcache.pm new file mode 100644 index 0000000..9ea14ea --- /dev/null +++ b/lib/Youri/Submit/Action/Sendcache.pm @@ -0,0 +1,81 @@ +# $Id: Sendcache.pm 232350 2007-12-07 18:26:17Z spuk $ +package Youri::Submit::Action::Sendcache; + +=head1 NAME + +Youri::Submit::Action::Sendcache - upload package to cache + +=head1 DESCRIPTION + +This action plugin uploads the package on uphost + +=cut + +use warnings; +use strict; +use Carp; +use File::Basename; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + uphost => '', + user => '', + ssh_key => '', + verbose => '', + root => '', + debug_pkgs => 0, + @_ + ); + croak "undefined upload host" unless $options{uphost}; + croak "undefined ssh key" unless $options{ssh_key}; + + foreach my $var ('perms', 'user', 'uphost', 'ssh_key', 'verbose', 'root', 'debug_pkgs') { + $self->{"_$var"} = $options{$var}; + } + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + # only cache debug packages if option debug_pkgs is true + return if ($package->is_debug() && !$self->{_debug_pkgs}); + + my $file = $package->get_file(); + my $dest = $repository->get_upload_dir($package, $target, $define); + $dest =~ s!$repository->{_upload_root}/$repository->{_queue}!$self->{_root}!; + + print "Sending file $file to $dest\n" if $self->{_verbose}; + my $destfile = "$dest".basename($file); + $destfile =~ s,/[^/_]+_([^/]+)$,/$1,; + $destfile =~ s,/@\d+:,/,; + my $destfilehidden = $destfile; + $destfilehidden =~ s,/([^/]+)$,/.$1,; + + my $cmd = "scp -i $self->{_ssh_key} $file $self->{_user}\@$self->{_uphost}:/$destfilehidden"; + my $cmd2 = "ssh -i $self->{_ssh_key} $self->{_user}\@$self->{_uphost} \"mv /$destfilehidden /$destfile\""; + print "Submit::Action::Send: doing $cmd\n$cmd2\n" if 1 || $self->{_verbose}; + if (!$self->{_test}) { + if (!system($cmd)) { + if (!system($cmd2)) { + print "Submit::Action::Sendcache: upload succeeded!\n"; + return 1 + } + } + print "Submit::Action::Sendcache: upload failed!\n"; + } +} +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/Sign.pm b/lib/Youri/Submit/Action/Sign.pm new file mode 100644 index 0000000..f016351 --- /dev/null +++ b/lib/Youri/Submit/Action/Sign.pm @@ -0,0 +1,56 @@ +# $Id: Sign.pm 1700 2006-10-16 12:57:42Z warly $ +package Youri::Submit::Action::Sign; + +=head1 NAME + +Youri::Submit::Action::Sign - GPG signature + +=head1 DESCRIPTION + +This action plugin ensures GPG signature of packages. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + name => '', + path => $ENV{HOME} . '/.gnupg', + passphrase => '', + @_ + ); + + croak "undefined name" unless $options{name}; + croak "undefined path" unless $options{path}; + croak "invalid path $options{path}" unless -d $options{path}; + + $self->{_name} = $options{name}; + $self->{_path} = $options{path}; + $self->{_passphrase} = $options{passphrase}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + $package->sign( + $self->{_name}, + $self->{_path}, + $self->{_passphrase} + ) unless $self->{_test}; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/Unpack.pm b/lib/Youri/Submit/Action/Unpack.pm new file mode 100644 index 0000000..03444df --- /dev/null +++ b/lib/Youri/Submit/Action/Unpack.pm @@ -0,0 +1,82 @@ +# $Id: Unpack.pm 115370 2007-01-30 09:59:07Z pixel $ +package Youri::Submit::Action::Unpack; + +=head1 NAME + +Youri::Submit::Action::Unpack - unpack package files + +=head1 DESCRIPTION + +This action plugin unpack package files somewhere. +When unpack_inside_distribution_root is set, dest_directory is relative to the distribution root. +When the package is a noarch, the wanted files are unpacked in distribution root of each archs. + +=cut + +use warnings; +use strict; +use Carp; +use File::Temp qw/tempdir/; +use base qw/Youri::Submit::Action/; + +sub _init { + my ($self, %options) = @_; + + croak "undefined package name" unless $options{name}; + croak "undefined source sub directory" unless $options{source_subdir}; + croak "undefined destination directory" unless $options{dest_directory}; + + foreach my $var ('name', 'dest_directory', 'source_subdir', 'grep_files', 'unpack_inside_distribution_root') { + $self->{"_$var"} = $options{$var}; + } + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + $package->get_name eq $self->{_name} or return; + + my @dests = $self->{_unpack_inside_distribution_root} ? + (map { "$_/$self->{_dest_directory}" } $repository->get_distribution_roots($package, $target)) + : $self->{_dest_directory}; + my $file = $package->as_file; + print "Unpacking rpm $file$self->{_source_subdir} to @dests\n" if $self->{_verbose}; + + my $tempdir = tempdir(CLEANUP => 1); + + my $cmd = "rpm2cpio $file | (cd $tempdir ; cpio -id)"; + print "Submit::Action::Unpack: doing $cmd\n" if $self->{_verbose}; + if (!$self->{_test} && system($cmd) != 0) { + print "Submit::Action::Unpack: failed!\n" if $self->{_verbose}; + return; + } + + foreach my $dest (@dests) { + my $find_grep = $self->{_grep_files} ? "find | grep '$self->{_grep_files}'" : 'find'; + my $cmd = "cd $tempdir/$self->{_source_subdir}; $find_grep | cpio -pdu $dest"; + print "Submit::Action::Unpack: doing $cmd\n" if $self->{_verbose}; + if (!$self->{_test}) { + my @l = glob("$tempdir/$self->{_source_subdir}"); + if (@l == 1 && -d $l[0]) { + if (system($cmd) != 0) { + print "Submit::Action::Unpack: failed!\n" if $self->{_verbose}; + } + } else { + print "Submit::Action::Unpack: directory $self->{_source_subdir} doesn't exist in package $self->{_name}\n"; + } + } + } +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Action/UpdateMdvDb.pm b/lib/Youri/Submit/Action/UpdateMdvDb.pm new file mode 100644 index 0000000..7906080 --- /dev/null +++ b/lib/Youri/Submit/Action/UpdateMdvDb.pm @@ -0,0 +1,62 @@ +# $Id$ +package Youri::Submit::Action::UpdateMdvDb; + +=head1 NAME + +Youri::Submit::Action::UpdateMdvDb - Mandriva maintainers database updater + +=head1 DESCRIPTION + +This action plugin calls an external script to update last commit info, as +well as add new packages, in the package maintainers database at +<http://maint.mandriva.com/>. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + @_ + ); + + # path for mdvdb-updaterep script + $self->{_mdvdb_updaterep} = $options{mdvdb_updaterep}; + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + # only SRPMs matter + return unless $package->is_source(); + + unless ($self->{_test}) { + my $pkg_name = $package->get_name(); + my $pkg_media = $repository->_get_main_section($package, $target, $define); + $package->get_packager() =~ m/(\w[-_.\w]+\@[-_.\w]+)\W/; + my $pkg_commiter = $1; + + if (system($self->{_mdvdb_updaterep}, "update", $pkg_name, $pkg_media, $pkg_commiter, "youri")) { + print "ERROR: ".$self->{_mdvdb_updaterep}." failed for '$pkg_name', '$pkg_media', '$pkg_commiter'.\n"; + } else { + print "Updated package maintainers DB for '$pkg_name', '$pkg_media', '$pkg_commiter'.\n" if $self->{_verbose}; + } + } +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2007, Mandriva + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check.pm b/lib/Youri/Submit/Check.pm new file mode 100644 index 0000000..cfa8f04 --- /dev/null +++ b/lib/Youri/Submit/Check.pm @@ -0,0 +1,27 @@ +# $Id: Base.pm 631 2006-01-26 22:22:23Z guillomovitch $ +package Youri::Submit::Check; + +=head1 NAME + +Youri::Submit::Check - Abstract check plugin + +=head1 DESCRIPTION + +This abstract class defines check plugin interface. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Plugin/; + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/ACL.pm b/lib/Youri/Submit/Check/ACL.pm new file mode 100644 index 0000000..925dc00 --- /dev/null +++ b/lib/Youri/Submit/Check/ACL.pm @@ -0,0 +1,71 @@ +# $Id: ACL.pm 4817 2007-02-09 19:39:05Z blino $ +package Youri::Submit::Check::ACL; + +=head1 NAME + +Youri::Submit::Check::Tag - Incorrect tag values check + +=head1 DESCRIPTION + +This check plugin rejects packages with incorrect tag values, based on regular +expressions. + +=cut + +use strict; +use Carp; +use base qw/Youri::Submit::Check/; +my $acl; + +sub _init { + my $self = shift; + my %options = ( + acl_file => '', + @_ + ); + $acl = get_acl($options{acl_file}); +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $file = $package->get_full_name(); + my $arch = $package->get_arch(); + my $srpm = $package->get_canonical_name; + my $section = $repository->_get_section($package, $target, $define); + my $user = $define->{user}; + foreach my $t (keys %$acl) { + next if $target !~ /$t/; + foreach my $acl (@{$acl->{$t}}) { + my ($a, $media, $r, $users) = @$acl; + next if $arch !~ $a || $srpm !~ $r || $section !~ $media; + if ($user =~ /$users/) { + return + } else { + return "$user is not authorized to upload packages belonging to $srpm in section $section (authorized persons: " . join(', ', split '\|', $users) . ")"; + } + } + } + return +} + +sub get_acl { + my ($file) = @_; + my %acl; + open my $f, $file; + while (<$f>) { + my ($dis, $arch, $media, $regexp, $users) = split ' '; + push @{$acl{$dis}}, [ $arch , $media, $regexp, $users ] + } + \%acl +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/History.pm b/lib/Youri/Submit/Check/History.pm new file mode 100644 index 0000000..c127ed6 --- /dev/null +++ b/lib/Youri/Submit/Check/History.pm @@ -0,0 +1,61 @@ +# $Id: History.pm 1707 2006-10-16 16:26:42Z warly $ +package Youri::Submit::Check::History; + +=head1 NAME + +Youri::Submit::Check::History - Non-linear history check + +=head1 DESCRIPTION + +This check plugin rejects packages whose history does not include last +available revision one. + +=cut + +use warnings; +use strict; +use Carp; +use Youri::Package; +use base qw/Youri::Submit::Check/; + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my @errors; + + my $last_revision = + $repository->get_last_older_revision($package, $target, $define); + + if ($last_revision) { + # skip the test if last revision has been produced from another source package, as it occurs during package split/merges + return + if $last_revision->get_canonical_name() + ne $package->get_canonical_name(); + + my ($last_revision_number) = $last_revision->get_last_change()->[Youri::Package::CHANGE_AUTHOR] =~ /(\S+)\s*$/; + my %entries = + map { $_ => 1 } + map { /(\S+)\s*$/ } + map { $_->[Youri::Package::CHANGE_AUTHOR] } + $package->get_changes(); + unless ($entries{$last_revision_number}) { + push( + @errors, + "Last changelog entry $last_revision_number from last revision " . $last_revision->get_full_name() . " missing from current changelog" + ); + } + } + + return @errors; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Host.pm b/lib/Youri/Submit/Check/Host.pm new file mode 100644 index 0000000..cadda4c --- /dev/null +++ b/lib/Youri/Submit/Check/Host.pm @@ -0,0 +1,63 @@ +# $Id: Host.pm 230850 2007-10-04 20:07:25Z blino $ +package Youri::Submit::Check::Host; + +=head1 NAME + +Youri::Submit::Check::Tag - Incorrect tag values check + +=head1 DESCRIPTION + +This check plugin rejects packages with incorrect tag values, based on regular +expressions. + +=cut + +use strict; +use Carp; +use base qw/Youri::Submit::Check/; +my $host; + +sub _init { + my $self = shift; + my %options = ( + host_file => '', + @_ + ); + $host = get_host($options{host_file}) +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $file = $package->get_file; + my $arch = $package->get_arch; + my $buildhost = $package->as_formated_string('%{buildhost}'); + foreach my $h (keys %$host) { + next if $buildhost !~ $h; + if ($arch =~ $host->{$h}) { + return + } + } + "Packages build on host $buildhost are not authorized for arch $arch"; +} + +sub get_host { + my ($file) = @_; + my %host; + open my $f, $file; + while (<$f>) { + my ($host, $arch) = split ' '; + $host{$host} = $arch + } + \%host +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Precedence.pm b/lib/Youri/Submit/Check/Precedence.pm new file mode 100644 index 0000000..c5f1a9e --- /dev/null +++ b/lib/Youri/Submit/Check/Precedence.pm @@ -0,0 +1,58 @@ +# $Id: Precedence.pm 1707 2006-10-16 16:26:42Z warly $ +package Youri::Submit::Check::Precedence; + +=head1 NAME + +Youri::Submit::Check::Precedence - Release check against another check + +=head1 DESCRIPTION + +This check plugin rejects packages whose an older revision already exists for +another upload target. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Check/; + +sub _init { + my $self = shift; + my %options = ( + _target => undef, # mandatory targets + @_ + ); + + die "undefined target" unless $options{target}; + + $self->{_target} = $options{target}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my @errors; + + my @older_revisions = + $repository->get_older_revisions($package, $self->{_target}, $define); + if (@older_revisions) { + push( + @errors, + "Older revisions still exists for $self->{_target}: " . join(', ', @older_revisions) + ); + } + + return @errors; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Queue_recency.pm b/lib/Youri/Submit/Check/Queue_recency.pm new file mode 100644 index 0000000..170d2af --- /dev/null +++ b/lib/Youri/Submit/Check/Queue_recency.pm @@ -0,0 +1,40 @@ +# $Id: Queue_recency.pm 4747 2007-01-30 10:02:41Z pixel $ +package Youri::Submit::Check::Queue_recency; + +=head1 NAME + +Youri::Submit::Check::Recency - Release check against current target + +=head1 DESCRIPTION + +This check plugin rejects packages whose a current or newer revision already +exists for current upload target. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Check/; + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my @newer_revisions = + $repository->get_upload_newer_revisions($package, $target, $define); + if (@newer_revisions) { + return "Newer revisions already exists for $target in upload queue: " . join(', ', @newer_revisions); + } + return +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Recency.pm b/lib/Youri/Submit/Check/Recency.pm new file mode 100644 index 0000000..04994b8 --- /dev/null +++ b/lib/Youri/Submit/Check/Recency.pm @@ -0,0 +1,64 @@ +# $Id: Recency.pm 224793 2007-07-08 02:44:48Z spuk $ +package Youri::Submit::Check::Recency; + +=head1 NAME + +Youri::Submit::Check::Recency - Release check against current target + +=head1 DESCRIPTION + +This check plugin rejects packages whose a current or newer revision already +exists for current upload target. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Check/; + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my @errors; + + my @revisions = $repository->get_revisions($package, $target, $define, undef, sub { return $_[0]->compare($package) >= 0 }); + if (@revisions) { + my $section = $repository->_get_section($package, $target, $define); + push( + @errors, + "Current or newer revision(s) already exists in $section for $target: " . + join(', ', @revisions) + ); + } + + my $defined_section = $define->{section}; + + # if the user provided a section, check also in the default section + if ($defined_section) { + $define->{section} = undef; + my @default_revisions = $repository->get_revisions($package, $target, $define, undef, sub { return $_[0]->compare($package) >= 0 }); + if (@default_revisions) { + my $section = $repository->_get_section($package, $target, $define); + push( + @errors, + "Current or newer revision(s) already exists in $section for $target: " . + join(', ', @default_revisions) + ); + } + $define->{section} = $defined_section; + } + + return @errors; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Rpmlint.pm b/lib/Youri/Submit/Check/Rpmlint.pm new file mode 100644 index 0000000..c57dd60 --- /dev/null +++ b/lib/Youri/Submit/Check/Rpmlint.pm @@ -0,0 +1,90 @@ +# $Id: Rpmlint.pm 234384 2008-02-12 09:42:32Z blino $ +package Youri::Submit::Check::Rpmlint; + +=head1 NAME + +Youri::Submit::Check::Rpmlint - Rpmlint-based check + +=head1 DESCRIPTION + +This check plugin wraps rpmlint, and reject packages triggering results +declared as fatal. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Check/; + +=head2 new(%args) + +Creates and returns a new Youri::Submit::Check::Rpmlint object. + +Specific parameters: + +=over + +=item results $results + +List of rpmlint result id considered as fatal. + +=item path $path + +Path to the rpmlint executable (default: /usr/bin/rpmlint) + +=item config $config + +Specific rpmlint configuration. + +=back + +=cut + + +sub _init { + my $self = shift; + my %options = ( + results => undef, + path => '/usr/bin/rpmlint', + config => '', + @_ + ); + + croak "no results to check" unless $options{results}; + croak "fatal should be an arrayref" unless ref $options{results} eq 'ARRAY'; + + $self->{_config} = $options{config}; + $self->{_path} = $options{path}; + $self->{_pattern} = '^(?:' . join('|', @{$options{results}}) . ')$'; +} + +sub run { + my ($self, $package, $_repository, $_target, $_define) = @_; + croak "Not a class method" unless ref $self; + + my @errors; + + my $command = "$self->{_path} -f $self->{_config} " . $package->as_file; + open(my $RPMLINT, "$command |") or die "Can't run $command: $!"; + while (my $line = <$RPMLINT>) { + $line =~ /^[EW]: \S+ (\S+)(.*)$/ # old rpmlint format + || $line =~ /^\S+: [EW]: (\S+)(.*)$/ or next; # new rpmlint format + my ($id, $value) = ($1, $2); + if ($id =~ /$self->{_pattern}/o) { + push(@errors, "$id$value"); + } + } + + return @errors; +} +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/SVN.pm b/lib/Youri/Submit/Check/SVN.pm new file mode 100644 index 0000000..e3362c8 --- /dev/null +++ b/lib/Youri/Submit/Check/SVN.pm @@ -0,0 +1,79 @@ +# $Id: SVN.pm 4747 2007-01-30 10:02:41Z pixel $ +package Youri::Submit::Check::SVN; + +=head1 NAME + +Youri::Submit::Check::Tag - Incorrect tag values check + +=head1 DESCRIPTION + +This check plugin rejects packages with incorrect tag values, based on regular +expressions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Check/; + +sub _init { + my $self = shift; + my %options = ( + svn => '', + @_ + ); + $self->{_svn} = $options{svn}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $section = $repository->_get_section($package, $target, $define); + if ($section =~ /\/(testing|backport)$/) { + # FIXME, right now ignore packages in SVN for testing and backports + # we need to find a clean way to handle them + return + } + + $package->is_source or return; + my $file = $package->get_file_name; + my $srpm_name = $package->get_canonical_name; + if ($repository->package_in_svn($srpm_name)) { + if ($file !~ /(^|\/|$define->{prefix}_)@\d+:\Q$srpm_name/) { + return "package $srpm_name is in the SVN, the uploaded SRPM must look like @<svn rev>:$srpm_name-<version>-<release>.src.rpm (created with getsrpm-mdk $srpm_name)"; + } else { + print "Package $file is correct\n"; + } + } + return +} + +sub simple_prompt { + my $cred = shift; + my $realm = shift; + my $default_username = shift; + my $may_save = shift; + my $pool = shift; + + print "Enter authentication info for realm: $realm\n"; + print "Username: "; + my $username = <>; + chomp($username); + $cred->username($username); + print "Password: "; + my $password = <>; + chomp($password); + $cred->password($password); +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Section.pm b/lib/Youri/Submit/Check/Section.pm new file mode 100644 index 0000000..4ff1675 --- /dev/null +++ b/lib/Youri/Submit/Check/Section.pm @@ -0,0 +1,58 @@ +# $Id: Precedence.pm 1707 2006-10-16 16:26:42Z warly $ +package Youri::Submit::Check::Section; + +=head1 NAME + +Youri::Submit::Check::Section - Check if package was submitted to the right section + +=head1 DESCRIPTION + +This check plugin rejects packages which were submitted to a section +different than the one where an older version already exists. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Check/; + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my @errors; + + my $submitted_main_section = $repository->_get_main_section($package, $target, $define); + + # undefine section, so that Repository::_get_section() of Mandriva_upload.pm + # finds the section from existing packages + my $defined_section = $define->{section}; + undef $define->{section}; + + my $old_main_section = $repository->_get_main_section($package, $target, $define); + my @older_revisions = $repository->get_older_revisions($package, $target, $define); + + # restore defined section + $define->{section} = $defined_section; + + if (@older_revisions && $submitted_main_section ne $old_main_section) { + push( + @errors, + "Section should be $old_main_section, not $submitted_main_section." + ); + } + + + return @errors; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2007, Mandriva + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Source.pm b/lib/Youri/Submit/Check/Source.pm new file mode 100644 index 0000000..9c47f5d --- /dev/null +++ b/lib/Youri/Submit/Check/Source.pm @@ -0,0 +1,45 @@ +# $Id: Source.pm 4747 2007-01-30 10:02:41Z pixel $ +package Youri::Submit::Check::Source; + +=head1 NAME + +Youri::Submit::Check::Tag - Incorrect tag values check + +=head1 DESCRIPTION + +This check plugin rejects packages with incorrect tag values, based on regular +expressions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Check/; + +sub _init { + my $self = shift; + my %options = ( + @_ + ); +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $file = $package->as_file(); + if (!$package->is_source()) { + return "Package $file is not a source rpm"; + } + return +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Tag.pm b/lib/Youri/Submit/Check/Tag.pm new file mode 100644 index 0000000..c0f9b9c --- /dev/null +++ b/lib/Youri/Submit/Check/Tag.pm @@ -0,0 +1,61 @@ +# $Id: Tag.pm 1707 2006-10-16 16:26:42Z warly $ +package Youri::Submit::Check::Tag; + +=head1 NAME + +Youri::Submit::Check::Tag - Incorrect tag values check + +=head1 DESCRIPTION + +This check plugin rejects packages with incorrect tag values, based on regular +expressions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Check/; + +sub _init { + my $self = shift; + my %options = ( + tags => undef, # expected tag values + @_ + ); + + croak "no tags to check" unless $options{tags}; + croak "tag should be an hashref" unless ref $options{tags} eq 'HASH'; + + $self->{_tags} = $options{tags}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my @errors; + + foreach my $tag (keys %{$self->{_tags}}) { + my $value = $package->get_tag($tag); + if ($value !~ /$self->{_tags}->{$tag}/) { + push( + @errors, + "invalid value $value for tag $tag" + ); + } + } + + return @errors; + +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Type.pm b/lib/Youri/Submit/Check/Type.pm new file mode 100644 index 0000000..d95af5a --- /dev/null +++ b/lib/Youri/Submit/Check/Type.pm @@ -0,0 +1,54 @@ +# $Id: Type.pm 4747 2007-01-30 10:02:41Z pixel $ +package Youri::Submit::Check::Type; + +=head1 NAME + +Youri::Submit::Check::Type - Type check + +=head1 DESCRIPTION + +This check plugin rejects packages with incorrect type. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Check/; + +sub _init { + my $self = shift; + my %options = ( + type => undef, # expected type + @_ + ); + + croak "no type to check" unless $options{type}; + croak "invalid type value" unless $options{type} =~ /^(?:source|binary)$/; + + $self->{_type} = $options{type}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my @errors; + + my $type = $package->get_type(); + if ($type ne $self->{_type}) { + push(@errors, "invalid type $type"); + } + + return @errors; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Version.pm b/lib/Youri/Submit/Check/Version.pm new file mode 100644 index 0000000..a9c2ae8 --- /dev/null +++ b/lib/Youri/Submit/Check/Version.pm @@ -0,0 +1,102 @@ +# $Id: Version.pm 267050 2010-03-23 17:36:49Z nvigier $ +package Youri::Submit::Check::Version; + +=head1 NAME + +Youri::Submit::Check::Version - Check if older version already exist in cooker (used in freeze period) + +=head1 DESCRIPTION + +This check plugin rejects new version of packages if they are not mentioned as authorized +in the configuration file or in a non frozen section. + +=cut + +use warnings; +use strict; +use Carp; +use URPM; +use base qw/Youri::Submit::Check/; + +sub _init { + my $self = shift; + my %options = ( + @_ + ); + + foreach my $target (keys %options) { + $self->{$target} = $options{$target} + } +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $opt = $self->{$target}; + return if $opt->{mode} eq 'normal'; + my $section = $repository->_get_section($package, $target, $define); + my $name = $package->get_canonical_name; + return if $name =~ /$opt->{authorized_packages}/; + my $arch = $repository->get_arch($package, $target, $define); + return if $arch =~ /$opt->{authorized_arches}/; + if ($opt->{mode} eq 'version_freeze') { + return if $section =~ /$opt->{authorized_sections}/; + my $user = $define->{user}; + return if $user =~ /^($opt->{authorized_users})$/; + my ($package_version) = $package =~ /-([^-]+)-[^-]+\.src$/; + $define->{arch} = 'src'; + my @revisions = $repository->get_revisions($package, $target, $define, undef, + sub { + my ($version) = $_[0] =~ /-([^-]+)-[^-]+\.src$/; + URPM::ranges_overlap("== $version", "< $package_version") + } + ); + $define->{arch} = ''; + if (@revisions) { + return "FREEZE, package @revisions of different versions exist in $target\n"; + } + } + # FIXME: The following code is not working and must be reviewed. + elsif ($opt->{mode} eq 'freeze') { + my $user = $define->{user}; + return if (defined($opt->{authorized_users}) && $user =~ /^($opt->{authorized_users})$/); + # XXX: So freeze mode really only check for this exceptions? + if ($section !~ /$opt->{authorized_sections}/) { + return "FREEZE: repository $target section $section is frozen, you can still submit your packages in testing\nTo do so use your.devel --define section=<section> $target <package 1> <package 2> ... <package n>"; + } + } else { + # FIXME: Calls to get_source_package seems invalid nowadays. + # This results on $source having a null content. + my $source = $package->get_source_package; + my ($package_version) = $source =~ /-([^-]+)-[^-]+\.src\.rpm$/; + $define->{arch} = 'src'; + # FIXME: get_revisions now expects the filter as the 5th element, and not the 4th. + my @revisions = $repository->get_revisions($package, $target, $define, + sub { + # FIXME: Calls to get_source_package seems invalid nowadays. + # This results on $source_package having a null content. + my $source_package = $_[0]->get_source_package; + my ($version) = $source_package =~ /-([^-]+)-[^-]+\.src\.rpm$/; + print STDERR "Found version $version\n"; + URPM::ranges_overlap("== $version", "< $package_version") + } + ); + $define->{arch} = ''; + if (@revisions) { + return "FREEZE, package @revisions of different versions exist in $target\n"; + } + } + return +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2006, YOURI project +Copyright (C) 2006, Mandriva + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; + diff --git a/lib/Youri/Submit/Plugin.pm b/lib/Youri/Submit/Plugin.pm new file mode 100644 index 0000000..4c72ff7 --- /dev/null +++ b/lib/Youri/Submit/Plugin.pm @@ -0,0 +1,93 @@ +# $Id: Plugin.pm 4746 2007-01-30 10:01:14Z pixel $ +package Youri::Submit::Plugin; + +=head1 NAME + +Youri::Submit::Plugin - Abstract youri-submit plugin + +=head1 DESCRIPTION + +This abstract class defines youri-submit plugin interface. + +=cut + +use warnings; +use strict; +use Carp; + +=head1 CLASS METHODS + +=head2 new(%args) + +Creates and returns a new Youri::Submit::Plugin object. + +No generic parameters (subclasses may define additional ones). + +Warning: do not call directly, call subclass constructor instead. + +=cut + +sub new { + my $class = shift; + croak "Abstract class" if $class eq __PACKAGE__; + + my %options = ( + id => '', # object id + test => 0, # test mode + verbose => 0, # verbose mode + @_ + ); + + my $self = bless { + _id => $options{id}, + _test => $options{test}, + _verbose => $options{verbose}, + }, $class; + + $self->_init(%options); + + return $self; +} + +sub _init { + # do nothing +} + +=head1 INSTANCE METHODS + +=head2 get_id() + +Returns plugin identity. + +=cut + +sub get_id { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_id}; +} + +=head2 run($package, $repository, $target, $define) + +Execute action on given L<Youri::Package> object. + +=head1 SUBCLASSING + +The following methods have to be implemented: + +=over + +=item run + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Post.pm b/lib/Youri/Submit/Post.pm new file mode 100644 index 0000000..b708b11 --- /dev/null +++ b/lib/Youri/Submit/Post.pm @@ -0,0 +1,27 @@ +# $Id: Post.pm 4746 2007-01-30 10:01:14Z pixel $ +package Youri::Submit::Post; + +=head1 NAME + +Youri::Submit::Post - Abstract post plugin + +=head1 DESCRIPTION + +This abstract class defines post plugin interface. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Plugin/; + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2006, Mandriva + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Post/CleanRpmsrate.pm b/lib/Youri/Submit/Post/CleanRpmsrate.pm new file mode 100644 index 0000000..977e2a0 --- /dev/null +++ b/lib/Youri/Submit/Post/CleanRpmsrate.pm @@ -0,0 +1,53 @@ +# $Id: CleanRpmsrate.pm 115367 2007-01-30 09:47:04Z pixel $ +package Youri::Submit::Post::CleanRpmsrate; + +=head1 NAME + +Youri::Submit::Post::CleanRpmsrate - calls clean-rpmsrate + +=head1 DESCRIPTION + +Calls clean-rpmsrate + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Post/; + +#- inlined from MDK::Common::DataStructure +sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ } + +sub _init { +} + +sub run { + my ($self, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $root = $repository->get_install_root(); + my @changed = @{$repository->get_arch_changed($target)}; + if (grep { $_ eq 'i586' } @changed) { + # x86_64 uses i586 pkgs, so rpmsrate need to be rebuild + @changed = uniq(@changed, 'x86_64'); + } + foreach my $arch (@changed) { + my $rpmsrate = "$root/$target/$arch/media/media_info/rpmsrate"; + my @media = "$root/$target/$arch/media/main/release"; + system("cp", "$rpmsrate-raw", "$rpmsrate-new"); + system("clean-rpmsrate", "$rpmsrate-new", @media); + system("mv", "-f", "$rpmsrate-new", $rpmsrate); + } + return +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2007, Mandriva <blino@mandriva.com> + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; + diff --git a/lib/Youri/Submit/Post/Gendistrib.pm b/lib/Youri/Submit/Post/Gendistrib.pm new file mode 100644 index 0000000..98205c7 --- /dev/null +++ b/lib/Youri/Submit/Post/Gendistrib.pm @@ -0,0 +1,66 @@ +# $Id: Gendistrib.pm 115367 2007-01-30 09:47:04Z pixel $ +package Youri::Submit::Post::Gendistrib; + +=head1 NAME + +Youri::Submit::Post::Gendistrib - calls gendistrib + +=head1 DESCRIPTION + +Calls gendistrib + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Post/; + +sub _init { + my $self = shift; + my %options = ( + user => '', + host => '', + source => '', + destination => '', + @_ + ); + + foreach my $var ('tmpdir', 'command') { + $self->{"_$var"} = $options{$var}; + } +} + +sub run { + my ($self, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $root = $repository->get_install_root(); + (undef, undef, my $hour) = gmtime(time); + # during the night, use complete hdlist rebuild + my $fast = '--fast'; + $fast = ''; # blino: don't use fast for now, it might be broken + if ($hour > 22 && $hour < 5) { + if ($hour < 4) { + $fast = '--blind' + } else { + $fast = '' + } + } + foreach my $arch (@{$repository->get_arch_changed($target)}) { + my $cmd = "TMPDIR=$self->{_tmpdir}/$target/$arch time $self->{_command} --nochkdep --nobadrpm $fast --noclean $root/$target/$arch"; + print "$cmd\n"; + system($cmd); + } + return +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, Mandriva <warly@mandriva.com> + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; + diff --git a/lib/Youri/Submit/Post/Genhdlist2.pm b/lib/Youri/Submit/Post/Genhdlist2.pm new file mode 100644 index 0000000..60886ef --- /dev/null +++ b/lib/Youri/Submit/Post/Genhdlist2.pm @@ -0,0 +1,82 @@ +# $Id: Gendistrib.pm 115367 2007-01-30 09:47:04Z pixel $ +package Youri::Submit::Post::Genhdlist2; + +=head1 NAME + +Youri::Submit::Post::Genhdlist2 - calls genhdlist2 + +=head1 DESCRIPTION + +Calls genhdlist2 + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Post/; + +sub _init { + my $self = shift; + my %options = ( + user => '', + host => '', + source => '', + destination => '', + @_ + ); + + foreach my $var ('command') { + $self->{"_$var"} = $options{$var}; + } +} + +sub run { + my ($self, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $root = $repository->get_install_root(); + my @changed = @{$repository->get_install_dir_changed($target)}; + if (!@changed) { + print "nothing to do\n"; + return; + } + foreach my $dir (@changed) { + my $file_deps = "$dir/../../media_info/file-deps"; + my $file_deps_option = -e $file_deps ? "--file-deps $file_deps" : ''; + my $cmd = "time $self->{_command} -v --versioned --allow-empty-media $file_deps_option $dir"; + print "$cmd\n"; + system($cmd) == 0 or print "ERROR: $cmd failed\n"; + } + + # need to redo global MD5SUM. This MD5SUM is mostly obsolete, but is still needed up to 2007.1 + # (and even on cooker for existing urpmi.cfg) + foreach my $arch (@{$repository->get_arch_changed($target)}) { + my $dir = "$root/$target/$arch/media/media_info"; + my $cmd = "cd $dir ; time md5sum hdlist_* synthesis.*"; + print "$cmd\n"; + my $m = `$cmd`; + open my $f, '>', "$dir/MD5SUM" or die "Can't write $dir/MD5SUM: $!\n"; + print $f $m; + + { + require MDV::Distribconf::Build; + my $distrib = MDV::Distribconf::Build->new("$root/$target/$arch"); + $distrib->loadtree or die "$root/$target/$arch does not seem to be a distribution tree\n"; + $distrib->parse_mediacfg; + $distrib->write_version($distrib->getfullpath(undef, "VERSION")); + print "updated $root/$target/$arch/VERSION\n"; + } + } + return; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, Mandriva <warly@mandriva.com> + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; + diff --git a/lib/Youri/Submit/Pre.pm b/lib/Youri/Submit/Pre.pm new file mode 100644 index 0000000..2d5b5c8 --- /dev/null +++ b/lib/Youri/Submit/Pre.pm @@ -0,0 +1,27 @@ +# $Id: Pre.pm 4746 2007-01-30 10:01:14Z pixel $ +package Youri::Submit::Pre; + +=head1 NAME + +Youri::Submit::Pre - Abstract pre plugin + +=head1 DESCRIPTION + +This abstract class defines pre plugin interface. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Plugin/; + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2006, Mandriva + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Pre/Rsync.pm b/lib/Youri/Submit/Pre/Rsync.pm new file mode 100644 index 0000000..accaace --- /dev/null +++ b/lib/Youri/Submit/Pre/Rsync.pm @@ -0,0 +1,87 @@ +# $Id: Rsync.pm 267280 2010-04-01 19:57:53Z bogdano $ +package Youri::Submit::Pre::Rsync; + +=head1 NAME + +Youri::Submit::Pre::Rsync - Old revisions archiving + +=head1 DESCRIPTION + +This action plugin ensures archiving of old package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Pre/; + +sub _init { + my $self = shift; + my %options = ( + user => '', + host => '', + source => '', + destination => '', + @_ + ); + + foreach my $var ('user', 'host', 'source', 'destination') { + $self->{"_$var"} = $options{$var}; + } +} + +sub run { + my ($self, $pre_packages, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + if (system("rsync --exclude '*.new' --exclude '.*' --remove-sent-files -avlPHe 'ssh -xc arcfour' $self->{_user}\@$self->{_host}:$self->{_source}/$target/ $self->{_destination}/$target/")) { + $self->{_error} = "Rsync command failed ($!)"; + return + } + my $queue = "$self->{_destination}/$target"; + $self->{_error} = "Reading queue directory failed"; + # now get the packages downloaded + my %packages; + opendir my $queuedh, "$self->{_destination}/$target/" or return "Could not open $self->{_destination}/$target"; + opendir my $targetdh, $queue or return "Could not open $queue"; + my $idx; + foreach my $media (readdir $targetdh) { + $media =~ /^\.{1,2}$/ and next; + print "$target - $media\n"; + if (-d "$queue/$media") { + opendir my $submediadh, "$queue/$media" or return "Could not open $queue/$media"; + foreach my $submedia (readdir $submediadh) { + $submedia =~ /^\.{1,2}$/ and next; + print "$target - $media - $submedia\n"; + opendir my $rpmdh, "$queue/$media/$submedia" or return "Could not open $queue/$media/$submedia"; + foreach my $rpm (readdir $rpmdh) { + $rpm =~ /^\.{1,2}$/ and next; + print "$target - $media - $submedia : $rpm\n"; + my $file = "$queue/$media/$submedia/$rpm"; + $file =~ s/\/+/\//g; + if ($rpm =~ /^(\d{14}\.\w+\.\w+\.\d+)_.*\.rpm$/) { + push @{$packages{$1}{rpms}}, { section => "$media/$submedia", file => $file }; + } elsif ($rpm =~ /\.rpm$/) { + $idx++; + push @{$packages{"independant_$idx"}{rpms}}, { section => "$media/$submedia", file => $file } + } + } + } + } + } + foreach my $key (keys %packages) { + push @$pre_packages, $packages{$key}{rpms} + } + return +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, Mandriva <warly@mandriva.com> + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Reject.pm b/lib/Youri/Submit/Reject.pm new file mode 100644 index 0000000..7d70e22 --- /dev/null +++ b/lib/Youri/Submit/Reject.pm @@ -0,0 +1,27 @@ +# $Id: Reject.pm 4746 2007-01-30 10:01:14Z pixel $ +package Youri::Submit::Reject; + +=head1 NAME + +Youri::Submit::Reject - Abstract reject plugin + +=head1 DESCRIPTION + +This abstract class defines reject plugin interface. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Plugin/; + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2006, Mandriva + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Reject/Archive.pm b/lib/Youri/Submit/Reject/Archive.pm new file mode 100644 index 0000000..e90bc19 --- /dev/null +++ b/lib/Youri/Submit/Reject/Archive.pm @@ -0,0 +1,61 @@ +# $Id: Archive.pm 4747 2007-01-30 10:02:41Z pixel $ +package Youri::Submit::Reject::Install; + +=head1 NAME + +Youri::Submit::Action::Archive - Old revisions archiving + +=head1 DESCRIPTION + +This action plugin ensures archiving of old package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Reject/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + @_ + ); + + $self->{_perms} = $options{perms}; + + return $self; +} + +sub run { + my ($self, $package, $errors, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $package->get_file(); + my $rpm = $package->get_file_name(); + my $dest = $repository->get_reject_dir($package, $target, $define); + + # FIXME remove prefix this should be done by a function + $rpm =~ s/^\d{14}\.\w+\.\w+\.\d+_//; + print "installing file $file to $dest/$rpm\n" ;#if $self->{_verbose}; + + unless ($self->{_test}) { + # create destination dir if needed + system("install -d -m " . ($self->{_perms} + 111) . " $dest/") + unless -d $dest; + + # install file to new location + system("install -m $self->{_perms} $file $dest/$rpm"); + } +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Reject/Clean.pm b/lib/Youri/Submit/Reject/Clean.pm new file mode 100644 index 0000000..9d6d003 --- /dev/null +++ b/lib/Youri/Submit/Reject/Clean.pm @@ -0,0 +1,36 @@ +# $Id: Clean.pm 4747 2007-01-30 10:02:41Z pixel $ +package Youri::Submit::Reject::Clean; + +=head1 NAME + +Youri::Submit::Action::Clean - Old revisions cleanup + +=head1 DESCRIPTION + +This action plugin ensures cleanup of old package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Reject/; + +sub run { + my ($self, $package, $errors, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $package->get_file(); + print "deleting file $file\n" if $self->{_verbose}; + unlink $file unless $self->{_test}; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1 diff --git a/lib/Youri/Submit/Reject/Install.pm b/lib/Youri/Submit/Reject/Install.pm new file mode 100644 index 0000000..f5215d1 --- /dev/null +++ b/lib/Youri/Submit/Reject/Install.pm @@ -0,0 +1,63 @@ +# $Id: Install.pm 4747 2007-01-30 10:02:41Z pixel $ +package Youri::Submit::Reject::Install; + +=head1 NAME + +Youri::Submit::Action::Archive - Old revisions archiving + +=head1 DESCRIPTION + +This action plugin ensures archiving of old package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Reject/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + @_ + ); + + $self->{_perms} = $options{perms}; + $self->{_verbose} = $options{verbose}; +} + +sub run { + my ($self, $package, $errors, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $package->get_file(); + my $rpm = $package->get_file_name(); + my $dest = $repository->get_reject_path($package, $target, $define); + + # FIXME remove prefix this should be done by a function + $rpm =~ s/^\d{14}\.\w+\.\w+\.\d+_//; + print "installing file $file to $dest/$rpm\n" if $self->{_verbose}; + + unless ($self->{_test}) { + # create destination dir if needed + system("install -d -m " . ($self->{_perms} + 111) . " $dest/") + unless -d $dest; + + # install file to new location + system("install -m $self->{_perms} $file $dest/$rpm"); + } + $package->{_file} = "$dest/$rpm"; + print "deleting file $file\n" if $self->{_verbose}; + unlink $file unless $self->{_test}; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Reject/Mail.pm b/lib/Youri/Submit/Reject/Mail.pm new file mode 100644 index 0000000..6fa50f7 --- /dev/null +++ b/lib/Youri/Submit/Reject/Mail.pm @@ -0,0 +1,112 @@ +# $Id: Mail.pm 223952 2007-06-23 13:54:13Z pixel $ +package Youri::Submit::Reject::Mail; + +=head1 NAME + +Youri::Submit::Action::Mail - Mail notification + +=head1 DESCRIPTION + +This action plugin ensures mail notification of new package revisions. + +=cut + +use warnings; +use strict; +use MIME::Entity; +use Encode qw/from_to/; +use Carp; +use Youri::Package; +use base qw/Youri::Submit::Reject/; + +sub _init { + my $self = shift; + my %options = ( + mta => '/usr/sbin/sendmail', + to => '', + from => '', + cc => '', + prefix => '', + encoding => 'quoted-printable', + charset => 'iso-8859-1', + @_ + ); + + croak "undefined mail MTA" unless $options{mta}; + croak "invalid mail MTA $options{mta}" unless -x $options{mta}; + croak "undefined to" unless $options{to}; + if ($options{cc}) { + croak "cc should be an hashref" unless ref $options{cc} eq 'HASH'; + } + croak "invalid charset $options{charset}" + unless Encode::resolve_alias($options{charset}); + + $self->{_mta} = $options{mta}; + $self->{_to} = $options{to}; + $self->{_from} = $options{from}; + $self->{_cc} = $options{cc}; + $self->{_prefix} = $options{prefix}; + $self->{_encoding} = $options{encoding}; + $self->{_charset} = $options{charset}; +} + +sub run { + my ($self, $package, $errors, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $section = $repository->_get_section($package, $target, $define); + + my $subject = + ($self->{_prefix} ? '[' . $self->{_prefix} . '] ' : '' ) . ($section ? "$section " : '') . + $package->get_revision_name(); + my $information = $package->get_information(); + my $last_change = $package->get_last_change(); + my $author = $last_change->[Youri::Package::CHANGE_AUTHOR] if $last_change; + my $list = $last_change->[Youri::Package::CHANGE_TEXT] if $last_change; + my $content = + "Errors: \n\n" . join("\n", map { + ( "* $_", (map { " - $_" } @{$errors->{$_}}), "\n"); + } sort(keys %$errors)) . "\n" . + $information . "\n" . + $author . ":\n$list"; + + # ensure proper codeset conversion + # for informations coming from package + my $charset = $repository->get_package_charset(); + from_to($content, $charset, $self->{_charset}); + from_to($subject, $charset, $self->{_charset}); + + my $mail = MIME::Entity->build( + Type => 'text/plain', + Charset => $self->{_charset}, + Encoding => $self->{_encoding}, + From => $self->{_from}, + To => $self->{_to}, + Subject => $subject, + Data => $content, + ); + + if ($self->{_cc}) { + my $cc = $self->{_cc}->{$package->get_name()}; + $mail->head()->add('cc', $cc) if $cc; + } + + if ($self->{_test}) { + $mail->print(\*STDOUT); + } else { + open(MAIL, "| $self->{_mta} -t -oi -oem") or die "Can't open MTA program: $!"; + $mail->print(\*MAIL); + close MAIL; + } + +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/t/00distribution.t b/t/00distribution.t new file mode 100755 index 0000000..3286c0e --- /dev/null +++ b/t/00distribution.t @@ -0,0 +1,15 @@ +#!/usr/bin/perl +# $Id: 00distribution.t 1723 2006-10-17 13:53:27Z warly $ + +use Test::More; + +BEGIN { + eval { + require Test::Distribution; + }; + if($@) { + plan skip_all => 'Test::Distribution not installed'; + } else { + import Test::Distribution only => [ qw/use pod description/ ]; + } +} |