[ViewVC] Annotation of: cvs/Coro/mymap/mymapd

#!/usr/bin/perl

use Coro;
use Coro::Event;
use Coro::Socket;

BEGIN { require "mymap.pl" };

$/ = $CRLF;

my $port = new Coro::Socket
        LocalPort => "imap",
        ReuseAddr => 1,
        Listen => 1,
   or die;

sub slog {
   my $level = shift;
   my $format = shift;
   printf "---: $format\n", @_;
}

sub resp {
   slog 9, ">>> @_";
   my $r;
   $r .= "* $_[$_]$CRLF" for 2 .. $#_-1;
   $r .= "$_[1] $_[$#_]$CRLF";
   print {$_[0]} $r;
}

$RE_pgrp = qr{
 (?:
      [^()]*
    | \( (??{ $RE_pgrp }) \)
 )*
}x;

sub expand_list {
   my @r;
   $_[0] =~ s/\*/$_[1]/g;
   for (split /,/, $_[0]) {
      if (/(\d+):(\d+)/) {
         push @r, $_ for $1 .. $2;
      } else {
         push @r, $_;
      }
   }
   \@r;
}

sub split_pgrp {
   my @r;
   while ($_[0] =~ /\G(?:([^( ]+)|\(($RE_pgrp)\)) ?/mg) {
      push @r, defined $1 ? $1 : $2;
   }
   \@r;
}

sub literal {
   "{" . (length $_[0]) . "}\015\012$_[0]";
}

sub handle_connection {
   my $fh = shift;

   eval {

      my $uid;      # user-id
      my $bid;      # mailbox-id
      my $readonly; # mailbox read-only?
      my @mid;      # message numbers

      my $expunge = sub {
         my $st = sql_exec \my($id),
                           "select id from msg
                            where flags & ($F_D|$F_deleted) = ($F_deleted)
                                  and bid = ?",
                           $bid;
         while ($st->fetch) {
            my %rev;
            @rev{@mid} = (1..@mid);
            my $idx = $rev{$id}
               or next;
            print $fh "* $idx EXPUNGE\015\012";
            splice @mid, $idx-1, 1;
            sql_exec "update msg set flags = flags | $F_D where id = ?", $id;
         }
      };

      my $close = sub {
         return unless $bid;
         sql_exec "update box set ctime = ? where id = ?", time, $bid;
         $bid = 0;
         @mid = ();
      };

      #resp $fh, "*", "OK IMAP4 service ready.";
      resp $fh, "*", "PREAUTH IMAP4 service ready."; #$uid = 1;
      CMD:
      while (<$fh>) {
         /^(\S+)(?: (\S+)([^\015\012]*))?$CRLF$/os or last;
         my ($tag, $cmd, $arg) = ($1, $2, $3);
         my @arg;
         $cmd = lc $cmd;
         while () {
            if ($arg =~ /\G "((?:[^"\\]*|\\.))"/gc
                #|| $arg =~ /\G ([^"(){ \x00-\x1f*%\\]+)/gc # ] is allowed...
                || $arg =~ /\G ([^"(){ \x00-\x1f%\\]+)/gc # evolution-fix
                || $arg =~ /\G \(($RE_pgrp)\)/gc) {
               push @arg, $1;
            } elsif ($arg =~ /\G {(\d+)}$/gc) {
               resp $fh, $tag, "literals not yet implemented";
               next CMD;
            } elsif ($arg =~ /\G$/gc) {
               last;
            } elsif ($arg =~ /\G(.*)$/gc) {
               $arg = $1;
               $arg =~ y/\015\012//d;
               resp $fh, $tag, "BAD parse error at '$arg' (@arg)";
               next CMD;
            } else {
               die;
            }
         }

         slog 9, "<<< $tag|$cmd|@arg";#d#
         if ($cmd eq "capability") {
            resp $fh, $tag, "CAPABILITY IMAP4", "OK";
         } elsif ($cmd eq "noop") {
            resp $fh, $tag, "OK";
            # bah!
         } elsif ($cmd eq "login" && !$uid) {
            my $st = sql_exec \$uid, "select id from user where name = ? and pass = ?", $arg[0], $arg[1];
            if ($st->fetch) {
               resp $fh, $tag, "OK";
            } else {
               resp $fh, $tag, "NO user unknown or authenticitation failure";
            }
         } elsif ($cmd eq "authenticitate" && !$uid) {
            resp $fh, "NO";
         } elsif ($cmd eq "logout") {
            resp $fh, $tag, "BYE", "OK";
            last CMD;
         } elsif ($uid) {
            my $U;

            if ($cmd eq "uid") {
               $cmd = lc shift @arg;
               $U = 1;
            }

            if ($cmd eq "select" || $cmd eq "examine") {
               &$close;

               $arg[0] = "INBOX" if lc $arg[0] eq "inbox";
               
               my $st = sql_exec \$bid, \my($ctime, $uidv),
                                 "select id, unix_timestamp(ctime), unix_timestamp(uidvalidity)
                                  from box where uid = ? and name = ?",
                                 $uid, $arg[0];
               if ($st->fetch) {
                  my $r = 0;
                  $st = sql_exec \my($mid, $ntime),
                                 "select id, ntime
                                  from msg
                                  where bid = ? and flags & $F_D = 0",
                                 $bid;
                  while ($st->fetch) {
                     $r++ if $ntime >= $ctime;
                     push @mid, $mid;
                  }
                  $readonly = $cmd eq "examine";
                  resp $fh, $tag,
                       (scalar@mid) . " EXISTS",
                       "$r RECENT",
                       "FLAGS (\\D \\Answered \\Flagged \\Deleted \\Seen \\Draft)",
                       "PERMANENTFLAGS (\\D \\Answered \\Flagged \\Deleted \\Seen \\Draft)",
                       "OK [UID-VALIDITY $uidv]",
                       "OK [READ-".($readonly ? "ONLY]" : "WRITE]");
               } else {
                  resp $fh, $tag, "NO mailbox does not exist";
               }

            # mailbox management
            } elsif ($cmd eq "create") {
               $arg[0] =~ s/\///;
               eval {
                  sql_exec "insert into box (uid, name) values (?, ?)", $uid, $arg[0];
               };
               if ($@) {
                  $@ =~ y/\015\012//d;
                  resp $fh, $tag, "NO $@";
               } else {
                  resp $fh, $tag, "OK";
               }
            } elsif ($cmd eq "delete") {
               if (lc $arg[0] ne "inbox" and sql_exec "delete from box where uid = ? and name = ?", $uid, $arg[0]) {
                  resp $fh, $tag, "OK";
               } else {
                  resp $fh, $tag, "NO";
               }
            } elsif ($cmd eq "rename") {
               eval {
                  sql_exec "update box set name = ? where uid = ? and name = ?", $arg[1], $uid, $arg[0];
               };
               if ($@) {
                  $@ =~ y/\015\012//d;
                  resp $fh, $tag, "NO $@";
               } else {
                  resp $fh, $tag, "OK";
               }
            } elsif ($cmd eq "subscribe" || $cmd eq "unsubscribe" || $cmd eq "lsub") {
               resp $fh, $tag, "NO not supported";
            } elsif ($cmd eq "list") {
               if ($arg[0] != "") {
                  resp $fh, $tag, "NO reference not supported";
               } else {
                  #$arg[1] =~ y/%/%/; #% not supported yet
                  $arg[1] =~ y/*/%/;
                  my $st = sql_exec \my($name), 
                                    "select name from box
                                     where uid = ? and name like ?",
                                    $uid, $arg[1];
                  my @r;
                  while ($st->fetch) {
                     push @r, "LIST () \"/\" $name";
                  }
                  resp $fh, $tag, @r, "OK";
               }
            } elsif ($cmd eq "append") {
               resp $fh, $tag, "BAD not supported yet!";

            # message handling
            } elsif ($bid) {
               if ($cmd eq "close") {
                  &$expunge;
                  &$close;
                  resp $fh, $tag, "OK";
               } elsif ($cmd eq "expunge") {
                  die if $U;
                  &$expunge;
                  resp $fh, $tag, "OK";
               } elsif ($cmd eq "fetch") {
                  my $list = expand_list($arg[0], scalar @mid);
                  my ($mid, $flags, $date, $head, $body);
                  my @exec;
                  my ($sql_body, $sql_head) = (0, 0);
                  my $sel = split_pgrp lc $arg[1];

                  while (my $s = shift @$sel) {
                     if ($s eq "all") {
                        push @$sel, qw(flags internaldate rfc822.size); next;
                     } elsif ($s eq "full") {
                        push @$sel, qw(flags internaldate rfc822.size envelope body); next;
                     } elsif ($s eq "uid") {
                        $s = sub { "UID $mid" };
                     } elsif ($s eq "flags") {
                        $s = sub { 
                           "FLAGS (" . (join " ", map "\\" . ucfirst $_, split /,/, $flags) . ")";
                        };
                     } elsif ($s eq "internaldate") {
                        $s = sub { "INTERNALDATE \"$date\"" };
                     } elsif ($s eq "rfc822.size") {
                        $sql_body = "body";
                        $s = sub { "RFC822.SIZE ".length $body };
                     } elsif ($s eq "rfc822.header") {
                        $sql_head = "header";
                        $s = sub { "RFC822.HEADER ".literal($head) };
                     } elsif ($s eq "rfc822") {
                        $sql_body = "body"; $sql_head = "header";
                        $s = sub { "RFC822 ".literal($head.$CRLF.$body) };
                     } elsif ($s eq "body.peek[0]") {#d# evolution-bug
                        $sql_head = "header";
                        $s = sub { "BODY[0] ".literal($head) };
                     } elsif ($s eq "rfc822.header.lines") {
                        $sql_head = "header";
                        my $re;
                        $re = '(?i:^((?:'
                            . (join "|", @{split_pgrp shift @$sel})
                            . '):[^\012\015]*))';
                        $re = qr($re);
                        
                        $s = sub {
                           "RFC822.HEADER.LINES ".literal (join $CRLF, $head =~ /$re/mg);
                        };
                     } else {
                        $s = sub { '""' };
                     }
                     push @exec, $s;
                  }

                  my %rev;
                  unless ($U) {
                     for (@$list) {
                        $mid = $mid[$_ - 1];
                        $rev{$mid} = $_;
                        $_ = $mid;
                     }
                  }

                  my $st = sql_exec \($mid, $flags, $date, $head, $body),
                                    "select id, flags, date_format(ntime, '%d-%m-%Y %h:%i:%s +0000'), $sql_head, $sql_body
                                     from msg
                                     where id in (".(join ",", @$list).")";
                                    
                  my $r;
                  while ($st->fetch) {
                     my $id = $U ? $mid : $rev{$mid};
                     $r .= "* $id FETCH (".(join " ", map &$_, @exec).")\015\12";
                     if (length $r > 32768) {
                        print $fh $r;
                        $r = "";
                     }
                  }
                  print $fh "$r$tag OK\015\012";
                  #resp $fh, $tag, "OK";
                  
               } elsif ($cmd eq "store") {
                  my $list = expand_list($arg[0], scalar @mid);
                  my $cmd = lc $arg[1];
                  my $flags = flags2bitmask(@{split_pgrp $arg[2]});

                  my %rev;
                  unless ($U) {
                     for (@$list) {
                        $mid = $mid[$_ - 1];
                        $rev{$mid} = $_;
                        $_ = $mid;
                     }
                  }

                  my $ids = join ",", @$list;

                  my $silent = $cmd =~ s/\.silent$//;

                  if ($cmd eq "flags") {
                     sql_exec "update msg set flags = ? where id in ($ids)", $flags;
                  } elsif ($cmd eq "+flags") {
                     sql_exec "update msg set flags = flags | ? where id in ($ids)", $flags;
                  } elsif ($cmd eq "-flags") {
                     sql_exec "update msg set flags = flags & ~? where id in ($ids)", $flags;
                  }
                  
                  if ($silent) {
                     resp $fh, $tag, "OK";
                  } else {
                     my $st = sql_exec \($mid, $flags),
                                       "select id, flags
                                        from msg
                                        where id in ($ids)";
                                       
                     my $r;
                     while ($st->fetch) {
                        my $id = $U ? $mid : $rev{$mid};
                        $r .= "* $id FLAGS (" . (join " ", map "\\" . ucfirst $_, split /,/, $flags) . ")\015\012";
                     }
                     print $fh "$r$tag OK\015\012";
                     #resp $fh, $tag, "OK";
                  }

               } else {
                  resp $fh, $tag, "BAD command not understood (nocommand)";
               }

            # well...
            } else {
               resp $fh, $tag, "BAD command not understood (notmailbox)";
            }
         
         } else {
            resp $fh, $tag, "BAD command not understood (notauth)";
         }
      }
   };
   if ($@) {
      resp $fh, "*", "BYE";
      slog 0, "$@";
   }
   slog 3, "$fh: closed connection\n";#d#
}

async {
   slog 1, "accepting connections";
   while () {
      my $fh = $port->accept;
      slog 3, "accepted $fh on $port";
      async \&handle_connection, $fh;
      undef $fh;
   }
};

loop;

Revision:	1.2
Committed:	Wed Aug 27 01:38:42 2003 UTC (20 years, 9 months ago) by pcg
Branch:	MAIN
Changes since 1.1:	+12 -8 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#!/usr/bin/perl
2
3			use Coro;
4			use Coro::Event;
5			use Coro::Socket;
6
7			BEGIN { require "mymap.pl" };
8
9			$/ = $CRLF;
10
11			my $port = new Coro::Socket
12	pcg	1.2	LocalPort => "imap",
13	root	1.1	ReuseAddr => 1,
14			Listen => 1,
15			or die;
16
17			sub slog {
18			my $level = shift;
19			my $format = shift;
20			printf "---: $format\n", @_;
21			}
22
23			sub resp {
24			slog 9, ">>> @_";
25			my $r;
26			$r .= "* $_[$_]$CRLF" for 2 .. $#_-1;
27			$r .= "$_[1] $_[$#_]$CRLF";
28			print {$_[0]} $r;
29			}
30
31			$RE_pgrp = qr{
32			(?:
33			[^()]*
34			\| \( (??{ $RE_pgrp }) \)
35			)*
36			}x;
37
38			sub expand_list {
39			my @r;
40			$_[0] =~ s/\*/$_[1]/g;
41			for (split /,/, $_[0]) {
42			if (/(\d+):(\d+)/) {
43			push @r, $_ for $1 .. $2;
44			} else {
45			push @r, $_;
46			}
47			}
48			\@r;
49			}
50
51			sub split_pgrp {
52			my @r;
53			while ($_[0] =~ /\G(?:([^( ]+)\|\(($RE_pgrp)\)) ?/mg) {
54			push @r, defined $1 ? $1 : $2;
55			}
56			\@r;
57			}
58
59			sub literal {
60	pcg	1.2	"{" . (length $_[0]) . "}\015\012$_[0]";
61	root	1.1	}
62
63			sub handle_connection {
64			my $fh = shift;
65
66			eval {
67
68			my $uid; # user-id
69			my $bid; # mailbox-id
70			my $readonly; # mailbox read-only?
71			my @mid; # message numbers
72
73			my $expunge = sub {
74			my $st = sql_exec \my($id),
75			"select id from msg
76			where flags & ($F_D\|$F_deleted) = ($F_deleted)
77			and bid = ?",
78			$bid;
79			while ($st->fetch) {
80			my %rev;
81			@rev{@mid} = (1..@mid);
82			my $idx = $rev{$id}
83			or next;
84			print $fh "* $idx EXPUNGE\015\012";
85			splice @mid, $idx-1, 1;
86			sql_exec "update msg set flags = flags \| $F_D where id = ?", $id;
87			}
88			};
89
90			my $close = sub {
91			return unless $bid;
92			sql_exec "update box set ctime = ? where id = ?", time, $bid;
93			$bid = 0;
94			@mid = ();
95			};
96
97			#resp $fh, "*", "OK IMAP4 service ready.";
98	pcg	1.2	resp $fh, "*", "PREAUTH IMAP4 service ready."; #$uid = 1;
99	root	1.1	CMD:
100			while (<$fh>) {
101			/^(\S+)(?: (\S+)([^\015\012]*))?$CRLF$/os or last;
102			my ($tag, $cmd, $arg) = ($1, $2, $3);
103			my @arg;
104			$cmd = lc $cmd;
105			while () {
106			if ($arg =~ /\G "((?:[^"\\]*\|\\.))"/gc
107	pcg	1.2	#\|\| $arg =~ /\G ([^"(){ \x00-\x1f*%\\]+)/gc # ] is allowed...
108			\|\| $arg =~ /\G ([^"(){ \x00-\x1f%\\]+)/gc # evolution-fix
109	root	1.1	\|\| $arg =~ /\G \(($RE_pgrp)\)/gc) {
110			push @arg, $1;
111			} elsif ($arg =~ /\G {(\d+)}$/gc) {
112			resp $fh, $tag, "literals not yet implemented";
113			next CMD;
114			} elsif ($arg =~ /\G$/gc) {
115			last;
116			} elsif ($arg =~ /\G(.*)$/gc) {
117			$arg = $1;
118			$arg =~ y/\015\012//d;
119			resp $fh, $tag, "BAD parse error at '$arg' (@arg)";
120			next CMD;
121			} else {
122			die;
123			}
124			}
125
126	pcg	1.2	slog 9, "<<< $tag\|$cmd\|@arg";#d#
127	root	1.1	if ($cmd eq "capability") {
128			resp $fh, $tag, "CAPABILITY IMAP4", "OK";
129			} elsif ($cmd eq "noop") {
130			resp $fh, $tag, "OK";
131			# bah!
132			} elsif ($cmd eq "login" && !$uid) {
133			my $st = sql_exec \$uid, "select id from user where name = ? and pass = ?", $arg[0], $arg[1];
134			if ($st->fetch) {
135			resp $fh, $tag, "OK";
136			} else {
137			resp $fh, $tag, "NO user unknown or authenticitation failure";
138			}
139			} elsif ($cmd eq "authenticitate" && !$uid) {
140			resp $fh, "NO";
141			} elsif ($cmd eq "logout") {
142			resp $fh, $tag, "BYE", "OK";
143			last CMD;
144			} elsif ($uid) {
145			my $U;
146
147			if ($cmd eq "uid") {
148			$cmd = lc shift @arg;
149			$U = 1;
150			}
151
152			if ($cmd eq "select" \|\| $cmd eq "examine") {
153			&$close;
154
155			$arg[0] = "INBOX" if lc $arg[0] eq "inbox";
156
157			my $st = sql_exec \$bid, \my($ctime, $uidv),
158			"select id, unix_timestamp(ctime), unix_timestamp(uidvalidity)
159			from box where uid = ? and name = ?",
160			$uid, $arg[0];
161			if ($st->fetch) {
162			my $r = 0;
163			$st = sql_exec \my($mid, $ntime),
164			"select id, ntime
165			from msg
166			where bid = ? and flags & $F_D = 0",
167			$bid;
168			while ($st->fetch) {
169			$r++ if $ntime >= $ctime;
170			push @mid, $mid;
171			}
172			$readonly = $cmd eq "examine";
173			resp $fh, $tag,
174			(scalar@mid) . " EXISTS",
175			"$r RECENT",
176			"FLAGS (\\D \\Answered \\Flagged \\Deleted \\Seen \\Draft)",
177			"PERMANENTFLAGS (\\D \\Answered \\Flagged \\Deleted \\Seen \\Draft)",
178			"OK [UID-VALIDITY $uidv]",
179			"OK [READ-".($readonly ? "ONLY]" : "WRITE]");
180			} else {
181			resp $fh, $tag, "NO mailbox does not exist";
182			}
183
184			# mailbox management
185			} elsif ($cmd eq "create") {
186			$arg[0] =~ s/\///;
187			eval {
188			sql_exec "insert into box (uid, name) values (?, ?)", $uid, $arg[0];
189			};
190			if ($@) {
191			$@ =~ y/\015\012//d;
192			resp $fh, $tag, "NO $@";
193			} else {
194			resp $fh, $tag, "OK";
195			}
196			} elsif ($cmd eq "delete") {
197			if (lc $arg[0] ne "inbox" and sql_exec "delete from box where uid = ? and name = ?", $uid, $arg[0]) {
198			resp $fh, $tag, "OK";
199			} else {
200			resp $fh, $tag, "NO";
201			}
202			} elsif ($cmd eq "rename") {
203			eval {
204			sql_exec "update box set name = ? where uid = ? and name = ?", $arg[1], $uid, $arg[0];
205			};
206			if ($@) {
207			$@ =~ y/\015\012//d;
208			resp $fh, $tag, "NO $@";
209			} else {
210			resp $fh, $tag, "OK";
211			}
212			} elsif ($cmd eq "subscribe" \|\| $cmd eq "unsubscribe" \|\| $cmd eq "lsub") {
213			resp $fh, $tag, "NO not supported";
214			} elsif ($cmd eq "list") {
215			if ($arg[0] != "") {
216			resp $fh, $tag, "NO reference not supported";
217			} else {
218			#$arg[1] =~ y/%/%/; #% not supported yet
219			$arg[1] =~ y/*/%/;
220			my $st = sql_exec \my($name),
221			"select name from box
222			where uid = ? and name like ?",
223			$uid, $arg[1];
224			my @r;
225			while ($st->fetch) {
226			push @r, "LIST () \"/\" $name";
227			}
228			resp $fh, $tag, @r, "OK";
229			}
230			} elsif ($cmd eq "append") {
231			resp $fh, $tag, "BAD not supported yet!";
232
233			# message handling
234			} elsif ($bid) {
235			if ($cmd eq "close") {
236			&$expunge;
237			&$close;
238			resp $fh, $tag, "OK";
239			} elsif ($cmd eq "expunge") {
240			die if $U;
241			&$expunge;
242			resp $fh, $tag, "OK";
243			} elsif ($cmd eq "fetch") {
244			my $list = expand_list($arg[0], scalar @mid);
245			my ($mid, $flags, $date, $head, $body);
246			my @exec;
247			my ($sql_body, $sql_head) = (0, 0);
248			my $sel = split_pgrp lc $arg[1];
249
250			while (my $s = shift @$sel) {
251			if ($s eq "all") {
252			push @$sel, qw(flags internaldate rfc822.size); next;
253			} elsif ($s eq "full") {
254			push @$sel, qw(flags internaldate rfc822.size envelope body); next;
255			} elsif ($s eq "uid") {
256			$s = sub { "UID $mid" };
257			} elsif ($s eq "flags") {
258			$s = sub {
259			"FLAGS (" . (join " ", map "\\" . ucfirst $_, split /,/, $flags) . ")";
260			};
261			} elsif ($s eq "internaldate") {
262			$s = sub { "INTERNALDATE \"$date\"" };
263			} elsif ($s eq "rfc822.size") {
264			$sql_body = "body";
265			$s = sub { "RFC822.SIZE ".length $body };
266			} elsif ($s eq "rfc822.header") {
267			$sql_head = "header";
268			$s = sub { "RFC822.HEADER ".literal($head) };
269			} elsif ($s eq "rfc822") {
270			$sql_body = "body"; $sql_head = "header";
271			$s = sub { "RFC822 ".literal($head.$CRLF.$body) };
272	pcg	1.2	} elsif ($s eq "body.peek[0]") {#d# evolution-bug
273			$sql_head = "header";
274			$s = sub { "BODY[0] ".literal($head) };
275	root	1.1	} elsif ($s eq "rfc822.header.lines") {
276			$sql_head = "header";
277			my $re;
278			$re = '(?i:^((?:'
279			. (join "\|", @{split_pgrp shift @$sel})
280			. '):[^\012\015]*))';
281			$re = qr($re);
282
283			$s = sub {
284			"RFC822.HEADER.LINES ".literal (join $CRLF, $head =~ /$re/mg);
285			};
286			} else {
287			$s = sub { '""' };
288			}
289			push @exec, $s;
290			}
291
292			my %rev;
293			unless ($U) {
294			for (@$list) {
295			$mid = $mid[$_ - 1];
296			$rev{$mid} = $_;
297			$_ = $mid;
298			}
299			}
300
301			my $st = sql_exec \($mid, $flags, $date, $head, $body),
302			"select id, flags, date_format(ntime, '%d-%m-%Y %h:%i:%s +0000'), $sql_head, $sql_body
303			from msg
304			where id in (".(join ",", @$list).")";
305
306			my $r;
307			while ($st->fetch) {
308			my $id = $U ? $mid : $rev{$mid};
309			$r .= "* $id FETCH (".(join " ", map &$_, @exec).")\015\12";
310			if (length $r > 32768) {
311			print $fh $r;
312			$r = "";
313			}
314			}
315			print $fh "$r$tag OK\015\012";
316			#resp $fh, $tag, "OK";
317
318			} elsif ($cmd eq "store") {
319			my $list = expand_list($arg[0], scalar @mid);
320			my $cmd = lc $arg[1];
321			my $flags = flags2bitmask(@{split_pgrp $arg[2]});
322
323			my %rev;
324			unless ($U) {
325			for (@$list) {
326			$mid = $mid[$_ - 1];
327			$rev{$mid} = $_;
328			$_ = $mid;
329			}
330			}
331
332			my $ids = join ",", @$list;
333
334			my $silent = $cmd =~ s/\.silent$//;
335
336			if ($cmd eq "flags") {
337			sql_exec "update msg set flags = ? where id in ($ids)", $flags;
338			} elsif ($cmd eq "+flags") {
339			sql_exec "update msg set flags = flags \| ? where id in ($ids)", $flags;
340			} elsif ($cmd eq "-flags") {
341			sql_exec "update msg set flags = flags & ~? where id in ($ids)", $flags;
342			}
343
344			if ($silent) {
345			resp $fh, $tag, "OK";
346			} else {
347			my $st = sql_exec \($mid, $flags),
348			"select id, flags
349			from msg
350			where id in ($ids)";
351
352			my $r;
353			while ($st->fetch) {
354			my $id = $U ? $mid : $rev{$mid};
355			$r .= "* $id FLAGS (" . (join " ", map "\\" . ucfirst $_, split /,/, $flags) . ")\015\012";
356			}
357			print $fh "$r$tag OK\015\012";
358			#resp $fh, $tag, "OK";
359			}
360
361			} else {
362	pcg	1.2	resp $fh, $tag, "BAD command not understood (nocommand)";
363	root	1.1	}
364
365			# well...
366			} else {
367	pcg	1.2	resp $fh, $tag, "BAD command not understood (notmailbox)";
368	root	1.1	}
369
370			} else {
371	pcg	1.2	resp $fh, $tag, "BAD command not understood (notauth)";
372	root	1.1	}
373			}
374			};
375			if ($@) {
376			resp $fh, "*", "BYE";
377			slog 0, "$@";
378			}
379			slog 3, "$fh: closed connection\n";#d#
380			}
381
382			async {
383			slog 1, "accepting connections";
384			while () {
385			my $fh = $port->accept;
386			slog 3, "accepted $fh on $port";
387			async \&handle_connection, $fh;
388			undef $fh;
389			}
390			};
391
392			loop;
393