Overview
| Comment: | cron: fix incorrect concurrent access to Event_List internals |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
ffb7e43a74c49d02035a996c333aa7a4 |
| User & Date: | nat on 2017-04-13 20:30:01 |
| Other Links: | manifest | tags |
Context
|
2017-05-05
| ||
| 19:50 | s_expressions-parsers-tests: fix alphabetical ordering of tests check-in: a76936f058 user: nat tags: trunk | |
|
2017-04-13
| ||
| 20:30 | cron: fix incorrect concurrent access to Event_List internals check-in: ffb7e43a74 user: nat tags: trunk | |
|
2017-04-12
| ||
| 20:54 |
cron-tests: new test to show an issue with unsafe access to Event_List
Thanks to OpenBSD for providing an environment where this issue could happen accidentally. Now to find a fix... check-in: 3267d1247d user: nat tags: trunk | |
Changes
Modified src/natools-cron.adb from [7158082d55] to [e86553a260].
1 | ------------------------------------------------------------------------------ | | | 1 2 3 4 5 6 7 8 9 | ------------------------------------------------------------------------------ -- Copyright (c) 2014-2017, Natacha Porté -- -- -- -- Permission to use, copy, modify, and distribute this software for any -- -- purpose with or without fee is hereby granted, provided that the above -- -- copyright notice and this permission notice appear in all copies. -- -- -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- |
| ︙ | ︙ | |||
306 307 308 309 310 311 312 313 314 315 316 317 318 319 |
else
Callback := Callback_Refs.Null_Reference;
end if;
First_Changed := False;
end Get_First;
entry Update_Notification when First_Changed is
begin
null;
end Update_Notification;
end Database;
| > > > > > > > > | 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 |
else
Callback := Callback_Refs.Null_Reference;
end if;
First_Changed := False;
end Get_First;
procedure Get_Event_List
(Source : in Event_List;
List : out Event_Lists.List) is
begin
List := Source.List;
end Get_Event_List;
entry Update_Notification when First_Changed is
begin
null;
end Update_Notification;
end Database;
|
| ︙ | ︙ | |||
354 355 356 357 358 359 360 361 | ---------------- -- Event List -- ---------------- overriding procedure Run (Self : in out Event_List) is begin | > > > | | 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 |
----------------
-- Event List --
----------------
overriding procedure Run (Self : in out Event_List) is
Local_List : Event_Lists.List;
begin
Database.Get_Event_List (Self, Local_List);
for Ref of Local_List loop
Ref.Update.Data.Run;
end loop;
end Run;
procedure Append
(Self : in out Event_List;
|
| ︙ | ︙ |
Modified src/natools-cron.ads from [503d6dd125] to [de34f4fcac].
1 | ------------------------------------------------------------------------------ | | | 1 2 3 4 5 6 7 8 9 | ------------------------------------------------------------------------------ -- Copyright (c) 2014-2017, Natacha Porté -- -- -- -- Permission to use, copy, modify, and distribute this software for any -- -- purpose with or without fee is hereby granted, provided that the above -- -- copyright notice and this permission notice appear in all copies. -- -- -- -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- |
| ︙ | ︙ | |||
100 101 102 103 104 105 106 107 108 109 110 111 112 113 |
type Cron_Entry is new Ada.Finalization.Limited_Controlled with record
Callback : Callback_Refs.Reference;
end record;
overriding procedure Finalize (Object : in out Cron_Entry);
function "<" (Left, Right : Periodic_Time) return Boolean;
-- Comparison function for ordered map
package Entry_Maps is new Ada.Containers.Ordered_Maps
(Periodic_Time, Callback_Refs.Reference, "<", Callback_Refs."=");
| > > > > > > > > > > > > > > > > > > > > > > > > > | 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 |
type Cron_Entry is new Ada.Finalization.Limited_Controlled with record
Callback : Callback_Refs.Reference;
end record;
overriding procedure Finalize (Object : in out Cron_Entry);
package Event_Lists is new Ada.Containers.Doubly_Linked_Lists
(Callback_Refs.Reference, Callback_Refs."=");
type Event_List is new Callback with record
List : Event_Lists.List;
end record;
overriding procedure Run (Self : in out Event_List);
-- Sequentially run the contained events
procedure Append
(Self : in out Event_List;
Ref : in Callback_Refs.Reference);
-- Append Ref at the end of Self.List
procedure Remove
(Self : in out Event_List;
Ref : in Callback_Refs.Reference;
Removed : out Boolean);
-- Remove Ref from Self.List, through a linear search
function Is_Empty (Self : Event_List) return Boolean;
-- Return whether Self contains any element
function "<" (Left, Right : Periodic_Time) return Boolean;
-- Comparison function for ordered map
package Entry_Maps is new Ada.Containers.Ordered_Maps
(Periodic_Time, Callback_Refs.Reference, "<", Callback_Refs."=");
|
| ︙ | ︙ | |||
128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 |
procedure Get_First
(Time : out Periodic_Time;
Callback : out Callback_Refs.Reference);
-- Return the next active callback, or an empty reference when
-- the database is empty (to signal task termination).
entry Update_Notification;
-- Block as long as the next active item does not change
private
Map : Entry_Maps.Map;
First_Changed : Boolean := False;
end Database;
task type Worker is
end Worker;
type Worker_Access is access Worker;
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Worker, Worker_Access);
Global_Worker : Worker_Access := null;
| > > > > > > < < < < < < < < < < < < < < < < < < < < < < < < < | 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 |
procedure Get_First
(Time : out Periodic_Time;
Callback : out Callback_Refs.Reference);
-- Return the next active callback, or an empty reference when
-- the database is empty (to signal task termination).
procedure Get_Event_List
(Source : in Event_List;
List : out Event_Lists.List);
-- Initialize an event list from Source without
-- any concurrent tampering of the list.
entry Update_Notification;
-- Block as long as the next active item does not change
private
Map : Entry_Maps.Map;
First_Changed : Boolean := False;
end Database;
task type Worker is
end Worker;
type Worker_Access is access Worker;
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Worker, Worker_Access);
Global_Worker : Worker_Access := null;
end Natools.Cron;
|